lisp/mh-e/mh-print.el

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