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