lisp/mh-e/mh-print.el

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