Commit | Line | Data |
---|---|---|
863e5e39 BW |
1 | ;;; mh-print.el --- MH-E printing support |
2 | ||
3 | ;; Copyright (C) 2003, 2004 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., 59 Temple Place - Suite 330, | |
25 | ;; Boston, MA 02111-1307, USA. | |
26 | ||
27 | ;;; Commentary: | |
28 | ;; Pp Print to lpr | Default inline settings | |
29 | ;; Pf Print to file | Generate a postscript file | |
30 | ;; Ps Print show buffer | Fails if no show buffer | |
31 | ;; | |
32 | ;; PA Toggle inline/attachments | |
33 | ;; PC Toggle color | |
34 | ;; PF Toggle faces | |
35 | ||
36 | ;;; Change Log: | |
37 | ||
38 | ;;; Code: | |
39 | ||
40 | (eval-when-compile (require 'mh-acros)) | |
41 | (mh-require-cl) | |
42 | (require 'ps-print) | |
43 | (require 'mh-utils) | |
44 | (require 'mh-funcs) | |
45 | (eval-when-compile (require 'mh-seq)) | |
46 | ||
47 | (defvar mh-ps-print-mime nil | |
48 | "Control printing of MIME parts. | |
49 | The three possible states are: | |
50 | 1. nil to not print inline parts | |
51 | 2. t to print inline parts | |
52 | 3. non-zero to print inline parts and attachments") | |
53 | ||
54 | (defvar mh-ps-print-color-option ps-print-color-p | |
55 | "MH-E's version of `\\[ps-print-color-p]'.") | |
56 | ||
57 | (defvar mh-ps-print-func 'ps-spool-buffer-with-faces | |
58 | "Function to use to spool a buffer. | |
59 | Sensible choices are the functions `ps-spool-buffer' and | |
60 | `ps-spool-buffer-with-faces'.") | |
61 | ||
62 | ;; XXX - If buffer is already being displayed, use that buffer | |
63 | ;; XXX - What about showing MIME content? | |
64 | ;; XXX - Default print buffer is bogus | |
65 | (defun mh-ps-spool-buffer (buffer) | |
66 | "Send BUFFER to printer queue." | |
67 | (message (format "mh-ps-spool-buffer %s" buffer)) | |
68 | (save-excursion | |
69 | (set-buffer buffer) | |
70 | (let ((ps-print-color-p mh-ps-print-color-option) | |
71 | (ps-left-header | |
72 | (list | |
73 | (concat "(" | |
74 | (mh-get-header-field "Subject:") ")") | |
75 | (concat "(" | |
76 | (mh-get-header-field "From:") ")"))) | |
77 | (ps-right-header | |
78 | (list | |
79 | "/pagenumberstring load" | |
80 | (concat "(" | |
81 | (mh-get-header-field "Date:") ")")))) | |
82 | (funcall mh-ps-print-func)))) | |
83 | ||
84 | (defun mh-ps-spool-a-msg (msg buffer) | |
85 | "Print MSG. | |
86 | First the message is decoded in BUFFER before the results are sent to the | |
87 | printer." | |
88 | (message (format "mh-ps-spool-a-msg msg %s buffer %s" | |
89 | msg buffer)) | |
90 | (let ((mh-show-buffer mh-show-buffer) | |
91 | (folder mh-current-folder) | |
92 | ;; The following is commented out because | |
93 | ;; `clean-message-header-flag' isn't used anywhere. I | |
94 | ;; commented rather than deleted in case somebody had some | |
95 | ;; future plans for it. --SY. | |
96 | ;(clean-message-header-flag mh-clean-message-header-flag) | |
97 | ) | |
98 | (unwind-protect | |
99 | (progn | |
100 | (setq mh-show-buffer buffer) | |
101 | (save-excursion | |
102 | ;; | |
103 | ;; XXX - Use setting of mh-ps-print-mime | |
104 | ;; | |
105 | (mh-display-msg msg folder) | |
106 | (mh-ps-spool-buffer mh-show-buffer) | |
107 | (kill-buffer mh-show-buffer)))))) | |
108 | ||
109 | ;;;###mh-autoload | |
110 | (defun mh-ps-print-msg (range) | |
111 | "Print the messages in RANGE. | |
112 | ||
113 | Check the documentation of `mh-interactive-range' to see how RANGE is read in | |
114 | interactive use." | |
115 | (interactive (list (mh-interactive-range "Print"))) | |
116 | (message (format "mh-ps-print-msg range %s keys %s" | |
117 | range (this-command-keys))) | |
118 | (mh-iterate-on-range msg range | |
119 | (let ((buffer (get-buffer-create mh-temp-buffer))) | |
120 | (unwind-protect | |
121 | (mh-ps-spool-a-msg msg buffer) | |
122 | (kill-buffer buffer))) | |
123 | (mh-notate nil mh-note-printed mh-cmd-note)) | |
124 | (ps-despool nil)) | |
125 | ||
126 | (defun mh-ps-print-preprint (prefix-arg) | |
127 | "Replacement for `ps-print-preprint'. | |
128 | The original function does not handle the fact that MH folders are directories | |
129 | nicely, when generating the default file name. This function works around | |
130 | that. The function is passed the interactive PREFIX-ARG." | |
131 | (let ((buffer-file-name (format "/tmp/%s" (substring (buffer-name) 1)))) | |
132 | (ps-print-preprint prefix-arg))) | |
133 | ||
134 | ;;;###mh-autoload | |
135 | (defun mh-ps-print-msg-file (file range) | |
136 | "Print to FILE the messages in RANGE. | |
137 | ||
138 | Check the documentation of `mh-interactive-range' to see how RANGE is read in | |
139 | interactive use." | |
140 | (interactive (list | |
141 | (mh-ps-print-preprint 1) | |
142 | (mh-interactive-range "Print"))) | |
143 | (mh-iterate-on-range msg range | |
144 | (let ((buffer (get-buffer-create mh-temp-buffer))) | |
145 | (unwind-protect | |
146 | (mh-ps-spool-a-msg msg buffer) | |
147 | (kill-buffer buffer))) | |
148 | (mh-notate nil mh-note-printed mh-cmd-note)) | |
149 | (ps-despool file)) | |
150 | ||
151 | ;;;###mh-autoload | |
152 | (defun mh-ps-print-msg-show (file) | |
153 | "Print current show buffer to FILE." | |
154 | (interactive (list (mh-ps-print-preprint current-prefix-arg))) | |
155 | (message (format "mh-ps-print-msg-show file %s keys %s mh-show-buffer %s" | |
156 | file (this-command-keys) mh-show-buffer)) | |
157 | (let ((msg (mh-get-msg-num t)) | |
158 | (folder mh-current-folder) | |
159 | (show-buffer mh-show-buffer) | |
160 | (show-window (get-buffer-window mh-show-buffer))) | |
161 | (if (and show-buffer show-window) | |
162 | (mh-in-show-buffer (show-buffer) | |
163 | (if (equal (mh-msg-filename msg folder) buffer-file-name) | |
164 | (progn | |
165 | (mh-ps-spool-buffer show-buffer) | |
166 | (ps-despool file)) | |
167 | (message "Current message is not being shown(1)."))) | |
168 | (message "Current message is not being shown(2).")))) | |
169 | ||
170 | ;;;###mh-autoload | |
171 | (defun mh-ps-print-toggle-faces () | |
172 | "Toggle whether printing is done with faces or not." | |
173 | (interactive) | |
174 | (if (eq mh-ps-print-func 'ps-spool-buffer-with-faces) | |
175 | (progn | |
176 | (setq mh-ps-print-func 'ps-spool-buffer) | |
177 | (message "Printing without faces")) | |
178 | (setq mh-ps-print-func 'ps-spool-buffer-with-faces) | |
179 | (message "Printing with faces"))) | |
180 | ||
181 | ;;;###mh-autoload | |
182 | (defun mh-ps-print-toggle-color () | |
183 | "Toggle whether color is used in printing messages." | |
184 | (interactive) | |
185 | (if (eq mh-ps-print-color-option nil) | |
186 | (progn | |
187 | (setq mh-ps-print-color-option 'black-white) | |
188 | (message "Colors will be printed as black & white.")) | |
189 | (if (eq mh-ps-print-color-option 'black-white) | |
190 | (progn | |
191 | (setq mh-ps-print-color-option t) | |
192 | (message "Colors will be printed.")) | |
193 | (setq mh-ps-print-color-option nil) | |
194 | (message "Colors will not be printed.")))) | |
195 | ||
196 | ;;; XXX: Check option 3. Documentation doesn't sound right. | |
197 | ;;;###mh-autoload | |
198 | (defun mh-ps-print-toggle-mime () | |
199 | "Cycle through available choices on how MIME parts should be printed. | |
200 | The available settings are: | |
201 | 1. Print only inline MIME parts. | |
202 | 2. Print all MIME parts. | |
203 | 3. Print no MIME parts." | |
204 | (interactive) | |
205 | (if (eq mh-ps-print-mime nil) | |
206 | (progn | |
207 | (setq mh-ps-print-mime t) | |
208 | (message "Inline parts will be printed, attachments will not be printed.")) | |
209 | (if (eq mh-ps-print-mime t) | |
210 | (progn | |
211 | (setq mh-ps-print-mime 1) | |
212 | (message "Both Inline parts and attachments will be printed.")) | |
213 | (setq mh-ps-print-mime nil) | |
214 | (message "Neither inline parts nor attachments will be printed.")))) | |
215 | ||
216 | ;;; Old non-PS based printing | |
217 | ;;;###mh-autoload | |
218 | (defun mh-print-msg (range) | |
219 | "Print RANGE on printer. | |
220 | ||
221 | Check the documentation of `mh-interactive-range' to see how RANGE is read in | |
222 | interactive use. | |
223 | ||
224 | The variable `mh-lpr-command-format' is used to generate the print command. | |
225 | The messages are formatted by mhl. See the variable `mhl-formfile'." | |
226 | (interactive (list (mh-interactive-range "Print"))) | |
227 | (message "Printing...") | |
228 | (let (msgs) | |
229 | ;; Gather message numbers and add them to "printed" sequence. | |
230 | (mh-iterate-on-range msg range | |
231 | (mh-add-msgs-to-seq msg 'printed t) | |
232 | (mh-notate nil mh-note-printed mh-cmd-note) | |
233 | (push msg msgs)) | |
234 | (setq msgs (nreverse msgs)) | |
235 | ;; Print scan listing if we have more than one message. | |
236 | (if (> (length msgs) 1) | |
237 | (let* ((msgs-string | |
238 | (mapconcat 'identity (mh-list-to-string | |
239 | (mh-coalesce-msg-list msgs)) " ")) | |
240 | (lpr-command | |
241 | (format mh-lpr-command-format | |
242 | (cond ((listp range) | |
243 | (format "Folder: %s, Messages: %s" | |
244 | mh-current-folder msgs-string)) | |
245 | ((symbolp range) | |
246 | (format "Folder: %s, Sequence: %s" | |
247 | mh-current-folder range))))) | |
248 | (scan-command | |
249 | (format "scan %s | %s" msgs-string lpr-command))) | |
250 | (if mh-print-background-flag | |
251 | (mh-exec-cmd-daemon shell-file-name nil "-c" scan-command) | |
252 | (call-process shell-file-name nil nil nil "-c" scan-command)))) | |
253 | ;; Print the messages | |
254 | (dolist (msg msgs) | |
255 | (let* ((mhl-command (format "%s %s %s" | |
256 | (expand-file-name "mhl" mh-lib-progs) | |
257 | (if mhl-formfile | |
258 | (format " -form %s" mhl-formfile) | |
259 | "") | |
260 | (mh-msg-filename msg))) | |
261 | (lpr-command | |
262 | (format mh-lpr-command-format | |
263 | (format "%s/%s" mh-current-folder msg))) | |
264 | (print-command | |
265 | (format "%s | %s" mhl-command lpr-command))) | |
266 | (if mh-print-background-flag | |
267 | (mh-exec-cmd-daemon shell-file-name nil "-c" print-command) | |
268 | (call-process shell-file-name nil nil nil "-c" print-command))))) | |
269 | (message "Printing...done")) | |
270 | ||
271 | (provide 'mh-print) | |
272 | ||
273 | ;;; Local Variables: | |
274 | ;;; indent-tabs-mode: nil | |
275 | ;;; sentence-end-double-space: nil | |
276 | ;;; End: | |
277 | ||
b22103fe | 278 | ;; arch-tag: 8d84d50b-2a49-4d0d-b51e-ba9c9b6fc679 |
863e5e39 | 279 | ;;; mh-print.el ends here |