Mercurial > emacs
annotate lisp/emacs-lisp/cust-print.el @ 50507:110c0e29159c
Handle multiple desktop files in different dirs.
Other cleanups.
Command line option --no-desktop introduced.
(desktop-read): Record buffers in the desktop file in
the same order as that in the buffer list,
(desktop-save): Put buffers in the order given in desktop file,
regardless of what handlers do.
(desktop-file-version): New variable. Version number of desktop
file format.
(desktop-create-buffer-form): Variable deleted.
(desktop-save): New customizable variable.
(desktop-kill): Changed to use `desktop-save'.
(desktop-file-name-format): New option: format in
which desktop file names should be saved.
(desktop-file-name): New function to convert a filename to the
format specified in `desktop-file-name-format'.
(desktop-create-buffer): Parameters renamed to descriptive
systematic names. These parameters are visible to handlers.
Renames:
ver -> desktop-file-version
mim -> desktop-buffer-minor-modes
pt -> desktop-buffer-point
mk -> desktop-buffer-mark
ro -> desktop-buffer-read-only
locals -> desktop-buffer-locals
(desktop-buffer-major-mode, desktop-buffer-file-name)
(desktop-buffer-name): Unused customizable variables deleted.
(desktop-buffer-misc): Unused variable deleted.
(desktop-save, desktop-buffer-dired-misc-data):
Use `desktop-file-name'.
(desktop-path): New customizable variable. List of directories in
which to lookup the desktop file. Replaces hardcoded list.
(desktop-globals-to-clear): New variable replaces hardcoded list.
(desktop-clear-preserve-buffers-regexp): New customizable variable.
(desktop-after-read-hook): New hook run after a desktop is read.
(desktop-no-desktop-file-hook): New hook when no desktop file found.
(desktop-change-dir): New function.
(desktop-save-in-load-dir): New function. Save desktop in
directory from witch it was loaded.
(desktop-revert): New function. Revert to the last loaded desktop.
author | Richard M. Stallman <rms@gnu.org> |
---|---|
date | Wed, 09 Apr 2003 01:37:56 +0000 |
parents | 0d8b17d428b5 |
children | 695cf19ef79e d7ddb3e565de |
rev | line source |
---|---|
38436
b174db545cfd
Some fixes to follow coding conventions.
Pavel Janík <Pavel@Janik.cz>
parents:
30805
diff
changeset
|
1 ;;; cust-print.el --- handles print-level and print-circle |
655 | 2 |
845 | 3 ;; Copyright (C) 1992 Free Software Foundation, Inc. |
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 | 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 | 13 ;; This file is part of GNU Emacs. |
14 | |
15 ;; GNU Emacs is free software; you can redistribute it and/or modify | |
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 | 18 ;; any later version. |
19 | |
20 ;; GNU Emacs is distributed in the hope that it will be useful, | |
21 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
22 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
23 ;; GNU General Public License for more details. | |
24 | |
25 ;; You should have received a copy of the GNU General Public License | |
26519 | 26 ;; along with GNU Emacs; see the file COPYING. If not, write to the |
27 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, | |
28 ;; Boston, MA 02111-1307, USA. | |
655 | 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 | 32 ;; This package provides a general print handler for prin1 and princ |
33 ;; that supports print-level and print-circle, and by the way, | |
34 ;; print-length since the standard routines are being replaced. Also, | |
35 ;; to print custom types constructed from lists and vectors, use | |
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 | 38 |
39 ;; If the results of your expressions contain circular references to | |
40 ;; other parts of the same structure, the standard Emacs print | |
41 ;; subroutines may fail to print with an untrappable error, | |
42 ;; "Apparently circular structure being printed". If you only use cdr | |
43 ;; circular lists (where cdrs of lists point back; what is the right | |
44 ;; term here?), you can limit the length of printing with | |
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 | 49 ;; option may be used to print more concise representations. |
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 | 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 | 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 | 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 | 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 | 75 |
76 ;; Implementation design: we want to use the same list and vector | |
77 ;; processing algorithm for all versions of prin1 and princ, since how | |
78 ;; the processing is done depends on print-length, print-level, and | |
79 ;; print-circle. For circle printing, a preprocessing step is | |
80 ;; required before the final printing. Thanks to Jamie Zawinski | |
81 ;; for motivation and algorithms. | |
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 | 85 |
86 (defgroup cust-print nil | |
87 "Handles print-level and print-circle." | |
88 :prefix "print-" | |
89 :group 'lisp | |
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 | 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 | 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 | 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 | 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 | 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 | 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 | 128 |
129 ;;(defvar print-length nil | |
130 ;; "*Controls how many elements of a list, at each level, are printed. | |
131 ;;This is defined by emacs.") | |
132 | |
26519 | 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 | 135 |
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 | 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 | 143 and if the object is a list or vector, its top-level components are at |
26519 | 144 level 1." |
145 :type '(choice (const nil) integer) | |
146 :group 'cust-print) | |
655 | 147 |
148 | |
26519 | 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 | 151 |
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 | 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 | 156 |
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 | 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 | 163 but if you need to do so, try the cl-read.el package." |
164 :type 'boolean | |
165 :group 'cust-print) | |
655 | 166 |
167 | |
26519 | 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 | 173 print-level, but not for vectors." |
174 :type 'boolean | |
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 |
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
181 (defconst custom-printers nil |
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 | 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 | 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 | 210 |
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 | 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 | 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 | 221 `(lambda (object) |
222 (cond | |
49598
0d8b17d428b5
Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
38436
diff
changeset
|
223 ,@(mapcar (function |
26519 | 224 (lambda (pair) |
49598
0d8b17d428b5
Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
38436
diff
changeset
|
225 `((,(car pair) object) |
26519 | 226 (,(cdr pair) object)))) |
227 custom-printers) | |
228 ;; Otherwise return nil. | |
229 (t nil) | |
230 )) | |
231 ;; ) | |
232 )) | |
655 | 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 | 236 ;;==================================================== |
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 | 254 |
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 | 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 | 262 '((prin1 custom-prin1) |
263 (princ custom-princ) | |
264 (print custom-print) | |
265 (prin1-to-string custom-prin1-to-string) | |
266 (format custom-format) | |
267 (message custom-message) | |
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 | 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 | 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 | 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 | 297 `(unwind-protect |
298 (progn | |
299 (custom-print-install) | |
300 ,@body) | |
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 | 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 | 307 |
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 | 310 Quoting characters are printed when needed to make output that `read' |
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 | 318 |
319 | |
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 | 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 | 329 |
26519 | 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 | 333 that `read' can handle, whenever this is possible, unless the optional |
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 | 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 | 344 (if noescape |
345 (custom-princ object buf) | |
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 | 352 |
353 | |
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 | 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 | 364 |
365 | |
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 | 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 | 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 | 385 (custom-prin1-to-string arg) |
386 arg))) | |
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 | 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 | 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 | 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 | 409 (custom-prin1-to-string arg) |
410 arg))) | |
411 args))) | |
49598
0d8b17d428b5
Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
38436
diff
changeset
|
412 |
655 | 413 |
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 | 419 (signal 'error (list (apply 'custom-format fmt args)))) |
420 | |
421 | |
6511
fb1c6b7aba39
Change "internal" to "original" throughout.
Daniel LaLiberte <liberte@gnu.org>
parents:
3591
diff
changeset
|
422 |
655 | 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 | 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 | 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 | 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 | 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 | 458 object)) |
459 | |
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 | 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 | 471 |
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 | 478 (let ((tag (assq object circle-table))) |
479 (if tag | |
480 (let ((id (cdr tag))) | |
481 (if (> id 0) | |
482 (progn | |
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 | 487 ;; Not printed yet, so label with id and print object. |
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 | 493 )) |
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 | 496 |
497 | |
498 ;;================================================ | |
499 ;; List and vector processing for print functions. | |
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 | 507 (let ((length (or print-length 0))) |
508 | |
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 | 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 | 513 (setq length (1- length)) |
514 | |
515 ;; Print the rest of the elements. | |
516 (while (and list (/= 0 length)) | |
517 (if (and (listp list) | |
518 (not (assq list circle-table))) | |
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 | 521 (setq list (cdr list))) |
522 | |
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 | 526 (setq list nil)) |
527 | |
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 | 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 | 533 list) |
534 | |
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 | 541 (i 0) |
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 | 544 |
545 (if print-length | |
546 (setq len (min print-length len))) | |
547 ;; Print the elements | |
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 | 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 | 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 | 555 )) |
556 vector) | |
557 | |
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 | 561 ;;================================== |
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 | 565 (let (;; Table of tags for each object in an object to be printed. |
566 ;; A tag is of the form: | |
567 ;; ( <object> <nil-t-or-id-number> ) | |
568 ;; The id-number is generated after the entire table has been computed. | |
569 ;; During walk through, the real circle-table lives in the cdr so we | |
570 ;; can use setcdr to add new elements instead of having to setq the | |
571 ;; variable sometimes (poor man's locf). | |
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 | 574 |
575 ;; Reverse table so it is in the order that the objects will be printed. | |
576 ;; This pass could be avoided if we always added to the end of the | |
577 ;; table with setcdr in walk-circle-tree. | |
578 (setcdr circle-table (nreverse (cdr circle-table))) | |
579 | |
580 ;; Walk through the table, assigning id-numbers to those | |
581 ;; objects which will be printed using #N= syntax. Delete those | |
582 ;; objects which will be printed only once (to speed up assq later). | |
583 (let ((rest circle-table) | |
584 (id -1)) | |
585 (while (cdr rest) | |
586 (let ((tag (car (cdr rest)))) | |
587 (cond ((cdr tag) | |
588 (setcdr tag id) | |
589 (setq id (1- id)) | |
590 (setq rest (cdr rest))) | |
591 ;; Else delete this object. | |
592 (t (setcdr rest (cdr (cdr rest)))))) | |
593 )) | |
594 ;; Drop the car. | |
595 (cdr circle-table) | |
596 )) | |
597 | |
598 | |
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 | 601 (let (read-equivalent-p tag) |
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 | 608 tag (and (not read-equivalent-p) |
609 (assq object (cdr circle-table)))) | |
610 (cond (tag | |
611 ;; Seen this object already, so note that. | |
612 (setcdr tag t)) | |
613 | |
614 ((not read-equivalent-p) | |
615 ;; Add a tag for this object. | |
616 (setcdr circle-table | |
617 (cons (list object) | |
618 (cdr circle-table))))) | |
619 (setq object | |
49598
0d8b17d428b5
Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
38436
diff
changeset
|
620 (cond |
655 | 621 (tag ;; No need to descend since we have already. |
622 nil) | |
623 | |
624 ((consp object) | |
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 | 627 ;; But walk the cdr with the above while loop |
628 ;; to avoid problems with max-lisp-eval-depth. | |
629 ;; And it should be faster than recursion. | |
630 (cdr object)) | |
631 | |
632 ((vectorp object) | |
633 ;; Walk the vector. | |
634 (let ((i (length object)) | |
635 (j 0)) | |
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 | 638 (setq j (1+ j)))))))))) |
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 | 642 ;;======================================= |
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 | 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 | 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 | 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 | 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 | 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 | 690 |
811
e694e0879463
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
807
diff
changeset
|
691 ;;; cust-print.el ends here |