lisp/mh-e/mh-print.el

   1 ;;; mh-print.el --- MH-E printing support
   2
   3 ;; Copyright (C) 2003-2012  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   (with-current-buffer buffer
 108     (let ((ps-print-color-p mh-ps-print-color-option)
 109           (ps-left-header
 110            (list
 111             (concat "(" (mh-get-header-field "Subject:") ")")
 112             (concat "(" (mh-get-header-field "From:") ")")))
 113           (ps-right-header
 114            (list
 115             "/pagenumberstring load"
 116             (concat "(" (mh-get-header-field "Date:") ")"))))
 117       (funcall mh-ps-print-func))))
 118
 119 ;;;###mh-autoload
 120 (defun mh-ps-print-msg-file (range file)
 121   "Print RANGE to FILE\\<mh-folder-mode-map>.
 122
 123 Check the documentation of `mh-interactive-range' to see how RANGE is
 124 read in interactive use.
 125
 126 This command will print inline text attachments but will not decrypt
 127 messages. However, when a message is displayed in an MH-Show buffer,
 128 then that buffer is used verbatim for printing with the caveat that
 129 only text attachments, if opened inline, are printed. Therefore,
 130 encrypted messages can be printed by showing and decrypting them
 131 first.
 132
 133 MH-E uses the \"ps-print\" package to do the printing, so you can
 134 customize the printing further by going to the `ps-print'
 135 customization group. This command does not use the options
 136 `mh-lpr-command-format' or `mh-print-background-flag'. See also the
 137 commands \\[mh-ps-print-toggle-color] and
 138 \\[mh-ps-print-toggle-faces]."
 139   (interactive (list (mh-interactive-range "Print") (mh-ps-print-preprint 1)))
 140   (mh-ps-print-range range file))
 141
 142 (defun mh-ps-print-preprint (prefix-arg)
 143   "Provide a better default file name for `ps-print-preprint'.
 144 Pass along the PREFIX-ARG to it."
 145   (let ((buffer-file-name (format "mh-%s" (substring (buffer-name) 1))))
 146     (ps-print-preprint prefix-arg)))
 147
 148 ;;;###mh-autoload
 149 (defun mh-ps-print-toggle-faces ()
 150  "Toggle whether printing is done with faces or not.
 151
 152 When faces are enabled, the printed message will look very
 153 similar to the message in the MH-Show buffer."
 154  (interactive)
 155  (if (eq mh-ps-print-func 'ps-spool-buffer-with-faces)
 156      (progn
 157        (setq mh-ps-print-func 'ps-spool-buffer)
 158        (message "Printing without faces"))
 159    (setq mh-ps-print-func 'ps-spool-buffer-with-faces)
 160    (message "Printing with faces")))
 161
 162 ;;;###mh-autoload
 163 (defun mh-ps-print-toggle-color ()
 164   "Toggle whether color is used in printing messages.
 165
 166 Colors are emulated on black-and-white printers with shades of
 167 gray. This might produce illegible output, even if your screen
 168 colors only use shades of gray. If this is the case, try using
 169 this command to toggle between color, no color, and a black and
 170 white representation of the colors and see which works best. You
 171 change this setting permanently by customizing the option
 172 `ps-print-color-p'."
 173  (interactive)
 174  (if (eq mh-ps-print-color-option nil)
 175      (progn
 176        (setq mh-ps-print-color-option 'black-white)
 177        (message "Colors will be printed as black & white"))
 178    (if (eq mh-ps-print-color-option 'black-white)
 179        (progn
 180          (setq mh-ps-print-color-option t)
 181          (message "Colors will be printed"))
 182      (setq mh-ps-print-color-option nil)
 183      (message "Colors will not be printed"))))
 184
 185 ;; Old non-PS based printing
 186 ;;;###mh-autoload
 187 (defun mh-print-msg (range)
 188   "Print RANGE the old fashioned way\\<mh-folder-mode-map>.
 189
 190 The message is formatted with \"mhl\" (see option
 191 `mh-mhl-format-file') and printed with the \"lpr\" command (see
 192 option `mh-lpr-command-format').
 193
 194 Check the documentation of `mh-interactive-range' to see how
 195 RANGE is read in interactive use.
 196
 197 Consider using \\[mh-ps-print-msg] instead."
 198   (interactive (list (mh-interactive-range "Print")))
 199   (message "Printing...")
 200   (let (msgs)
 201     ;; Gather message numbers and add them to "printed" sequence.
 202     (mh-iterate-on-range msg range
 203       (mh-add-msgs-to-seq msg 'printed t)
 204       (mh-notate nil mh-note-printed mh-cmd-note)
 205       (push msg msgs))
 206     (setq msgs (nreverse msgs))
 207     ;; Print scan listing if we have more than one message.
 208     (if (> (length msgs) 1)
 209         (let* ((msgs-string
 210                 (mapconcat 'identity (mh-list-to-string
 211                                       (mh-coalesce-msg-list msgs)) " "))
 212                (lpr-command
 213                 (format mh-lpr-command-format
 214                         (cond ((listp range)
 215                                (format "Folder: %s, Messages: %s"
 216                                        mh-current-folder msgs-string))
 217                               ((symbolp range)
 218                                (format "Folder: %s, Sequence: %s"
 219                                        mh-current-folder range)))))
 220                (scan-command
 221                 (format "scan %s | %s" msgs-string lpr-command)))
 222           (if mh-print-background-flag
 223               (mh-exec-cmd-daemon shell-file-name nil "-c" scan-command)
 224             (call-process shell-file-name nil nil nil "-c" scan-command))))
 225     ;; Print the messages
 226     (dolist (msg msgs)
 227       (let* ((mhl-command (format "%s %s %s"
 228                                   (expand-file-name "mhl" mh-lib-progs)
 229                                   (if mh-mhl-format-file
 230                                       (format " -form %s" mh-mhl-format-file)
 231                                     "")
 232                                   (mh-msg-filename msg)))
 233              (lpr-command
 234               (format mh-lpr-command-format
 235                       (format "%s/%s" mh-current-folder msg)))
 236              (print-command
 237               (format "%s | %s" mhl-command lpr-command)))
 238         (if mh-print-background-flag
 239             (mh-exec-cmd-daemon shell-file-name nil "-c" print-command)
 240           (call-process shell-file-name nil nil nil "-c" print-command)))))
 241   (message "Printing...done"))
 242
 243 (provide 'mh-print)
 244
 245 ;; Local Variables:
 246 ;; indent-tabs-mode: nil
 247 ;; sentence-end-double-space: nil
 248 ;; End:
 249
 250 ;;; mh-print.el ends here