Mercurial > emacs
comparison lisp/mh-e/mh-print.el @ 88155:d7ddb3e565de
sync with trunk
author | Henrik Enberg <henrik.enberg@telia.com> |
---|---|
date | Mon, 16 Jan 2006 00:03:54 +0000 |
parents | |
children |
comparison
equal
deleted
inserted
replaced
88154:8ce476d3ba36 | 88155:d7ddb3e565de |
---|---|
1 ;;; mh-print.el --- MH-E printing support | |
2 | |
3 ;; Copyright (C) 2003, 2004, 2005, 2006 Free Software Foundation, Inc. | |
4 | |
5 ;; Author: Jeffrey C Honig <jch@honig.net> | |
6 ;; Maintainer: Bill Wohler <wohler@newt.com> | |
7 ;; Keywords: mail | |
8 ;; See: mh-e.el | |
9 | |
10 ;; This file is part of GNU Emacs. | |
11 | |
12 ;; GNU Emacs is free software; you can redistribute it and/or modify | |
13 ;; it under the terms of the GNU General Public License as published by | |
14 ;; the Free Software Foundation; either version 2, or (at your option) | |
15 ;; any later version. | |
16 | |
17 ;; GNU Emacs is distributed in the hope that it will be useful, | |
18 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
20 ;; GNU General Public License for more details. | |
21 | |
22 ;; You should have received a copy of the GNU General Public License | |
23 ;; along with GNU Emacs; see the file COPYING. If not, write to the | |
24 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, | |
25 ;; Boston, MA 02110-1301, USA. | |
26 | |
27 ;;; Commentary: | |
28 | |
29 ;;; Change Log: | |
30 | |
31 ;;; Code: | |
32 | |
33 ;;(message "> mh-print") | |
34 (eval-when-compile (require 'mh-acros)) | |
35 (mh-require-cl) | |
36 (require 'ps-print) | |
37 (require 'mh-buffers) | |
38 (require 'mh-utils) | |
39 (require 'mh-funcs) | |
40 (eval-when-compile (require 'mh-seq)) | |
41 ;;(message "< mh-print") | |
42 | |
43 (defvar mh-ps-print-color-option ps-print-color-p | |
44 "Specify how buffer's text color is printed. | |
45 | |
46 Valid values are: | |
47 | |
48 nil - Do not print colors. | |
49 t - Print colors. | |
50 black-white - Print colors on black/white printer. | |
51 See also `ps-black-white-faces'. | |
52 | |
53 Any other value is treated as t. This variable is initialized | |
54 from `ps-print-color-p'.") | |
55 | |
56 (defvar mh-ps-print-func 'ps-spool-buffer-with-faces | |
57 "Function to use to spool a buffer. | |
58 | |
59 Sensible choices are the functions `ps-spool-buffer' and | |
60 `ps-spool-buffer-with-faces'.") | |
61 | |
62 (defun mh-ps-spool-buffer (buffer) | |
63 "Spool BUFFER." | |
64 (save-excursion | |
65 (set-buffer buffer) | |
66 (let ((ps-print-color-p mh-ps-print-color-option) | |
67 (ps-left-header | |
68 (list | |
69 (concat "(" (mh-get-header-field "Subject:") ")") | |
70 (concat "(" (mh-get-header-field "From:") ")"))) | |
71 (ps-right-header | |
72 (list | |
73 "/pagenumberstring load" | |
74 (concat "(" (mh-get-header-field "Date:") ")")))) | |
75 (funcall mh-ps-print-func)))) | |
76 | |
77 (defun mh-ps-spool-msg (msg) | |
78 "Spool MSG." | |
79 (let* ((folder mh-current-folder) | |
80 (buffer (mh-in-show-buffer (mh-show-buffer) | |
81 (if (not (equal (mh-msg-filename msg folder) | |
82 buffer-file-name)) | |
83 (get-buffer-create mh-temp-buffer))))) | |
84 (unwind-protect | |
85 (save-excursion | |
86 (if buffer | |
87 (let ((mh-show-buffer buffer)) | |
88 (mh-display-msg msg folder))) | |
89 (mh-ps-spool-buffer (if buffer buffer mh-show-buffer))) | |
90 (if buffer | |
91 (kill-buffer buffer))))) | |
92 | |
93 (defun mh-ps-print-range (range file) | |
94 "Print RANGE to FILE. | |
95 | |
96 This is the function that actually does the work. | |
97 If FILE is nil, then the messages are spooled to the printer." | |
98 (mh-iterate-on-range msg range | |
99 (unwind-protect | |
100 (mh-ps-spool-msg msg)) | |
101 (mh-notate msg mh-note-printed mh-cmd-note)) | |
102 (ps-despool file)) | |
103 | |
104 (defun mh-ps-print-preprint (prefix-arg) | |
105 "Provide a better default file name for `ps-print-preprint'. | |
106 Pass along the PREFIX-ARG to it." | |
107 (let ((buffer-file-name (format "mh-%s" (substring (buffer-name) 1)))) | |
108 (ps-print-preprint prefix-arg))) | |
109 | |
110 ;;;###mh-autoload | |
111 (defun mh-ps-print-msg (range) | |
112 "Print RANGE\\<mh-folder-mode-map>. | |
113 | |
114 Check the documentation of `mh-interactive-range' to see how RANGE is | |
115 read in interactive use. | |
116 | |
117 This command will print inline text attachments but will not decrypt | |
118 messages. However, when a message is displayed in an MH-Show buffer, | |
119 then that buffer is used verbatim for printing with the caveat that | |
120 only text attachments, if opened inline, are printed. Therefore, | |
121 encrypted messages can be printed by showing and decrypting them | |
122 first. | |
123 | |
124 MH-E uses the \"ps-print\" package to do the printing, so you can | |
125 customize the printing further by going to the `ps-print' | |
126 customization group. This command does not use the options | |
127 `mh-lpr-command-format' or `mh-print-background-flag'. See also the | |
128 commands \\[mh-ps-print-toggle-color] and | |
129 \\[mh-ps-print-toggle-faces]." | |
130 (interactive (list (mh-interactive-range "Print"))) | |
131 (mh-ps-print-range range nil)) | |
132 | |
133 ;;;###mh-autoload | |
134 (defun mh-ps-print-msg-file (range file) | |
135 "Print RANGE to FILE\\<mh-folder-mode-map>. | |
136 | |
137 Check the documentation of `mh-interactive-range' to see how RANGE is | |
138 read in interactive use. | |
139 | |
140 This command will print inline text attachments but will not decrypt | |
141 messages. However, when a message is displayed in an MH-Show buffer, | |
142 then that buffer is used verbatim for printing with the caveat that | |
143 only text attachments, if opened inline, are printed. Therefore, | |
144 encrypted messages can be printed by showing and decrypting them | |
145 first. | |
146 | |
147 MH-E uses the \"ps-print\" package to do the printing, so you can | |
148 customize the printing further by going to the `ps-print' | |
149 customization group. This command does not use the options | |
150 `mh-lpr-command-format' or `mh-print-background-flag'. See also the | |
151 commands \\[mh-ps-print-toggle-color] and | |
152 \\[mh-ps-print-toggle-faces]." | |
153 (interactive (list (mh-interactive-range "Print") (mh-ps-print-preprint 1))) | |
154 (mh-ps-print-range range file)) | |
155 | |
156 ;;;###mh-autoload | |
157 (defun mh-ps-print-toggle-faces () | |
158 "Toggle whether printing is done with faces or not. | |
159 | |
160 When faces are enabled, the printed message will look very | |
161 similar to the message in the MH-Show buffer." | |
162 (interactive) | |
163 (if (eq mh-ps-print-func 'ps-spool-buffer-with-faces) | |
164 (progn | |
165 (setq mh-ps-print-func 'ps-spool-buffer) | |
166 (message "Printing without faces")) | |
167 (setq mh-ps-print-func 'ps-spool-buffer-with-faces) | |
168 (message "Printing with faces"))) | |
169 | |
170 ;;;###mh-autoload | |
171 (defun mh-ps-print-toggle-color () | |
172 "Toggle whether color is used in printing messages. | |
173 | |
174 Colors are emulated on black-and-white printers with shades of | |
175 gray. This might produce illegible output, even if your screen | |
176 colors only use shades of gray. If this is the case, try using | |
177 this command to toggle between color, no color, and a black and | |
178 white representation of the colors and see which works best. You | |
179 change this setting permanently by customizing the option | |
180 `ps-print-color-p'." | |
181 (interactive) | |
182 (if (eq mh-ps-print-color-option nil) | |
183 (progn | |
184 (setq mh-ps-print-color-option 'black-white) | |
185 (message "Colors will be printed as black & white")) | |
186 (if (eq mh-ps-print-color-option 'black-white) | |
187 (progn | |
188 (setq mh-ps-print-color-option t) | |
189 (message "Colors will be printed")) | |
190 (setq mh-ps-print-color-option nil) | |
191 (message "Colors will not be printed")))) | |
192 | |
193 ;; Old non-PS based printing | |
194 ;;;###mh-autoload | |
195 (defun mh-print-msg (range) | |
196 "Print RANGE the old fashioned way\\<mh-folder-mode-map>. | |
197 | |
198 The message is formatted with \"mhl\" (see option | |
199 `mh-mhl-format-file') and printed with the \"lpr\" command (see | |
200 option `mh-lpr-command-format'). | |
201 | |
202 Check the documentation of `mh-interactive-range' to see how | |
203 RANGE is read in interactive use. | |
204 | |
205 Consider using \\[mh-ps-print-msg] instead." | |
206 (interactive (list (mh-interactive-range "Print"))) | |
207 (message "Printing...") | |
208 (let (msgs) | |
209 ;; Gather message numbers and add them to "printed" sequence. | |
210 (mh-iterate-on-range msg range | |
211 (mh-add-msgs-to-seq msg 'printed t) | |
212 (mh-notate nil mh-note-printed mh-cmd-note) | |
213 (push msg msgs)) | |
214 (setq msgs (nreverse msgs)) | |
215 ;; Print scan listing if we have more than one message. | |
216 (if (> (length msgs) 1) | |
217 (let* ((msgs-string | |
218 (mapconcat 'identity (mh-list-to-string | |
219 (mh-coalesce-msg-list msgs)) " ")) | |
220 (lpr-command | |
221 (format mh-lpr-command-format | |
222 (cond ((listp range) | |
223 (format "Folder: %s, Messages: %s" | |
224 mh-current-folder msgs-string)) | |
225 ((symbolp range) | |
226 (format "Folder: %s, Sequence: %s" | |
227 mh-current-folder range))))) | |
228 (scan-command | |
229 (format "scan %s | %s" msgs-string lpr-command))) | |
230 (if mh-print-background-flag | |
231 (mh-exec-cmd-daemon shell-file-name nil "-c" scan-command) | |
232 (call-process shell-file-name nil nil nil "-c" scan-command)))) | |
233 ;; Print the messages | |
234 (dolist (msg msgs) | |
235 (let* ((mhl-command (format "%s %s %s" | |
236 (expand-file-name "mhl" mh-lib-progs) | |
237 (if mh-mhl-format-file | |
238 (format " -form %s" mh-mhl-format-file) | |
239 "") | |
240 (mh-msg-filename msg))) | |
241 (lpr-command | |
242 (format mh-lpr-command-format | |
243 (format "%s/%s" mh-current-folder msg))) | |
244 (print-command | |
245 (format "%s | %s" mhl-command lpr-command))) | |
246 (if mh-print-background-flag | |
247 (mh-exec-cmd-daemon shell-file-name nil "-c" print-command) | |
248 (call-process shell-file-name nil nil nil "-c" print-command))))) | |
249 (message "Printing...done")) | |
250 | |
251 (provide 'mh-print) | |
252 | |
253 ;; Local Variables: | |
254 ;; indent-tabs-mode: nil | |
255 ;; sentence-end-double-space: nil | |
256 ;; End: | |
257 | |
258 ;; arch-tag: 8d84d50b-2a49-4d0d-b51e-ba9c9b6fc679 | |
259 ;;; mh-print.el ends here |