1 ;;; mh-print.el --- MH-E printing support
3 ;; Copyright (C) 2003, 2004, 2005 Free Software Foundation, Inc.
5 ;; Author: Jeffrey C Honig <jch@honig.net>
6 ;; Maintainer: Bill Wohler <wohler@newt.com>
10 ;; This file is part of GNU Emacs.
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)
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.
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.
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
32 ;; PA Toggle inline/attachments
40 (eval-when-compile (require 'mh-acros
))
45 (eval-when-compile (require 'mh-seq
))
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")
54 (defvar mh-ps-print-color-option ps-print-color-p
55 "MH-E's version of `\\[ps-print-color-p]'.")
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'.")
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 "mh-ps-spool-buffer %s" buffer
)
70 (let ((ps-print-color-p mh-ps-print-color-option
)
74 (mh-get-header-field "Subject:") ")")
76 (mh-get-header-field "From:") ")")))
79 "/pagenumberstring load"
81 (mh-get-header-field "Date:") ")"))))
82 (funcall mh-ps-print-func
))))
84 (defun mh-ps-spool-a-msg (msg buffer
)
86 First the message is decoded in BUFFER before the results are sent to the
88 (message "mh-ps-spool-a-msg msg %s buffer %s"
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)
100 (setq mh-show-buffer buffer
)
103 ;; XXX - Use setting of mh-ps-print-mime
105 (mh-display-msg msg folder
)
106 (mh-ps-spool-buffer mh-show-buffer
)
107 (kill-buffer mh-show-buffer
))))))
110 (defun mh-ps-print-msg (range)
111 "Print the messages in RANGE.
113 Check the documentation of `mh-interactive-range' to see how RANGE is read in
115 (interactive (list (mh-interactive-range "Print")))
116 (message "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
)))
121 (mh-ps-spool-a-msg msg buffer
)
122 (kill-buffer buffer
)))
123 (mh-notate nil mh-note-printed mh-cmd-note
))
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
)))
135 (defun mh-ps-print-msg-file (file range
)
136 "Print to FILE the messages in RANGE.
138 Check the documentation of `mh-interactive-range' to see how RANGE is read in
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
)))
146 (mh-ps-spool-a-msg msg buffer
)
147 (kill-buffer buffer
)))
148 (mh-notate nil mh-note-printed mh-cmd-note
))
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 "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
)
165 (mh-ps-spool-buffer show-buffer
)
167 (message "Current message is not being shown(1).")))
168 (message "Current message is not being shown(2)."))))
171 (defun mh-ps-print-toggle-faces ()
172 "Toggle whether printing is done with faces or not."
174 (if (eq mh-ps-print-func
'ps-spool-buffer-with-faces
)
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")))
182 (defun mh-ps-print-toggle-color ()
183 "Toggle whether color is used in printing messages."
185 (if (eq mh-ps-print-color-option nil
)
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
)
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."))))
196 ;;; XXX: Check option 3. Documentation doesn't sound right.
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."
205 (if (eq mh-ps-print-mime nil
)
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
)
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."))))
216 ;;; Old non-PS based printing
218 (defun mh-print-msg (range)
219 "Print RANGE on printer.
221 Check the documentation of `mh-interactive-range' to see how RANGE is read in
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...")
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
)
234 (setq msgs
(nreverse msgs
))
235 ;; Print scan listing if we have more than one message.
236 (if (> (length msgs
) 1)
238 (mapconcat 'identity
(mh-list-to-string
239 (mh-coalesce-msg-list msgs
)) " "))
241 (format mh-lpr-command-format
243 (format "Folder: %s, Messages: %s"
244 mh-current-folder msgs-string
))
246 (format "Folder: %s, Sequence: %s"
247 mh-current-folder range
)))))
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
255 (let* ((mhl-command (format "%s %s %s"
256 (expand-file-name "mhl" mh-lib-progs
)
258 (format " -form %s" mhl-formfile
)
260 (mh-msg-filename msg
)))
262 (format mh-lpr-command-format
263 (format "%s/%s" mh-current-folder msg
)))
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"))
274 ;;; indent-tabs-mode: nil
275 ;;; sentence-end-double-space: nil
278 ;; arch-tag: 8d84d50b-2a49-4d0d-b51e-ba9c9b6fc679
279 ;;; mh-print.el ends here