code.delx.au - gnu-emacs/blob - lisp/mh-e/mh-print.el

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