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