Mercurial > emacs
annotate lisp/mh-e/mh-print.el @ 64518:7b82147924c7
(org-table-formula-substitute-names, org-table-get-vertical-vector): Doc fixes.
(org-table-recalculate): Remove unused argument to `message'.
author | Juanma Barranquero <lekktu@gmail.com> |
---|---|
date | Tue, 19 Jul 2005 23:37:03 +0000 |
parents | 18a818a2ee7c |
children | 8e711c68e4ff |
rev | line source |
---|---|
56676 | 1 ;;; mh-print.el --- MH-E printing support |
2 | |
62847
aa8c2e12ee24
Upgraded to MH-E version 7.84.
Bill Wohler <wohler@newt.com>
parents:
62465
diff
changeset
|
3 ;; Copyright (C) 2003, 2004 Free Software Foundation, Inc. |
56676 | 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 | |
64085 | 24 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, |
25 ;; Boston, MA 02110-1301, USA. | |
56676 | 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 | |
56677 | 278 ;; arch-tag: 8d84d50b-2a49-4d0d-b51e-ba9c9b6fc679 |
56676 | 279 ;;; mh-print.el ends here |