]> code.delx.au - gnu-emacs/blobdiff - lisp/mh-e/mh-print.el
Add 2010 to copyright years.
[gnu-emacs] / lisp / mh-e / mh-print.el
index fd837072014cd724bfcfee728df9ff7582ab33f9..846596d79eba4afc1a2622e6675bd5fd946fb6d6 100644 (file)
@@ -1,6 +1,7 @@
 ;;; mh-print.el --- MH-E printing support
 
-;; Copyright (C) 2003, 2004, 2005, 2006 Free Software Foundation, Inc.
+;; Copyright (C) 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010
+;;   Free Software Foundation, Inc.
 
 ;; Author: Jeffrey C Honig <jch@honig.net>
 ;; Maintainer: Bill Wohler <wohler@newt.com>
 
 ;; This file is part of GNU Emacs.
 
-;; GNU Emacs is free software; you can redistribute it and/or modify
+;; GNU Emacs is free software: you can redistribute it and/or modify
 ;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
-;; any later version.
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
 
 ;; GNU Emacs is distributed in the hope that it will be useful,
 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
@@ -20,9 +21,7 @@
 ;; GNU General Public License for more details.
 
 ;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING.  If not, write to the
-;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
+;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
 
 ;;; Commentary:
 
 
 ;;; Code:
 
-(eval-when-compile (require 'mh-acros))
-(mh-require-cl)
+(require 'mh-e)
+(require 'mh-scan)
+
 (require 'ps-print)
-(require 'mh-buffers)
-(require 'mh-utils)
-(require 'mh-funcs)
-(eval-when-compile (require 'mh-seq))
 
 (defvar mh-ps-print-color-option ps-print-color-p
   "Specify how buffer's text color is printed.
@@ -46,7 +42,7 @@ Valid values are:
    nil         - Do not print colors.
    t           - Print colors.
    black-white - Print colors on black/white printer.
-                See also `ps-black-white-faces'.
+                 See also `ps-black-white-faces'.
 
 Any other value is treated as t. This variable is initialized
 from `ps-print-color-p'.")
@@ -57,54 +53,6 @@ from `ps-print-color-p'.")
 Sensible choices are the functions `ps-spool-buffer' and
 `ps-spool-buffer-with-faces'.")
 
-(defun mh-ps-spool-buffer (buffer)
-  "Spool BUFFER."
-  (save-excursion
-    (set-buffer buffer)
-    (let ((ps-print-color-p mh-ps-print-color-option)
-          (ps-left-header
-           (list
-            (concat "(" (mh-get-header-field "Subject:") ")")
-            (concat "(" (mh-get-header-field "From:") ")")))
-          (ps-right-header
-           (list
-            "/pagenumberstring load"
-            (concat "(" (mh-get-header-field "Date:") ")"))))
-      (funcall mh-ps-print-func))))
-
-(defun mh-ps-spool-msg (msg)
-  "Spool MSG."
-  (let* ((folder mh-current-folder)
-         (buffer (mh-in-show-buffer (mh-show-buffer)
-                   (if (not (equal (mh-msg-filename msg folder)
-                                   buffer-file-name))
-                       (get-buffer-create mh-temp-buffer)))))
-    (unwind-protect
-        (save-excursion
-          (if buffer
-              (let ((mh-show-buffer buffer))
-                (mh-display-msg msg folder)))
-          (mh-ps-spool-buffer (if buffer buffer mh-show-buffer)))
-      (if buffer
-          (kill-buffer buffer)))))
-
-(defun mh-ps-print-range (range file)
-  "Print RANGE to FILE.
-
-This is the function that actually does the work.
-If FILE is nil, then the messages are spooled to the printer."
-  (mh-iterate-on-range msg range
-    (unwind-protect
-        (mh-ps-spool-msg msg))
-    (mh-notate msg mh-note-printed mh-cmd-note))
-  (ps-despool file))
-
-(defun mh-ps-print-preprint (prefix-arg)
-  "Provide a better default file name for `ps-print-preprint'.
-Pass along the PREFIX-ARG to it."
-  (let ((buffer-file-name (format "mh-%s" (substring (buffer-name) 1))))
-    (ps-print-preprint prefix-arg)))
-
 ;;;###mh-autoload
 (defun mh-ps-print-msg (range)
   "Print RANGE\\<mh-folder-mode-map>.
@@ -128,6 +76,47 @@ commands \\[mh-ps-print-toggle-color] and
   (interactive (list (mh-interactive-range "Print")))
   (mh-ps-print-range range nil))
 
+(defun mh-ps-print-range (range file)
+  "Print RANGE to FILE.
+
+This is the function that actually does the work.
+If FILE is nil, then the messages are spooled to the printer."
+  (mh-iterate-on-range msg range
+    (unwind-protect
+        (mh-ps-spool-msg msg))
+    (mh-notate msg mh-note-printed mh-cmd-note))
+  (ps-despool file))
+
+(defun mh-ps-spool-msg (msg)
+  "Spool MSG."
+  (let* ((folder mh-current-folder)
+         (buffer (mh-in-show-buffer (mh-show-buffer)
+                   (if (not (equal (mh-msg-filename msg folder)
+                                   buffer-file-name))
+                       (get-buffer-create mh-temp-buffer)))))
+    (unwind-protect
+        (save-excursion
+          (if buffer
+              (let ((mh-show-buffer buffer))
+                (mh-display-msg msg folder)))
+          (mh-ps-spool-buffer (if buffer buffer mh-show-buffer)))
+      (if buffer
+          (kill-buffer buffer)))))
+
+(defun mh-ps-spool-buffer (buffer)
+  "Spool BUFFER."
+  (with-current-buffer buffer
+    (let ((ps-print-color-p mh-ps-print-color-option)
+          (ps-left-header
+           (list
+            (concat "(" (mh-get-header-field "Subject:") ")")
+            (concat "(" (mh-get-header-field "From:") ")")))
+          (ps-right-header
+           (list
+            "/pagenumberstring load"
+            (concat "(" (mh-get-header-field "Date:") ")"))))
+      (funcall mh-ps-print-func))))
+
 ;;;###mh-autoload
 (defun mh-ps-print-msg-file (range file)
   "Print RANGE to FILE\\<mh-folder-mode-map>.
@@ -151,6 +140,12 @@ commands \\[mh-ps-print-toggle-color] and
   (interactive (list (mh-interactive-range "Print") (mh-ps-print-preprint 1)))
   (mh-ps-print-range range file))
 
+(defun mh-ps-print-preprint (prefix-arg)
+  "Provide a better default file name for `ps-print-preprint'.
+Pass along the PREFIX-ARG to it."
+  (let ((buffer-file-name (format "mh-%s" (substring (buffer-name) 1))))
+    (ps-print-preprint prefix-arg)))
+
 ;;;###mh-autoload
 (defun mh-ps-print-toggle-faces ()
  "Toggle whether printing is done with faces or not.
@@ -183,8 +178,8 @@ change this setting permanently by customizing the option
        (message "Colors will be printed as black & white"))
    (if (eq mh-ps-print-color-option 'black-white)
        (progn
-        (setq mh-ps-print-color-option t)
-        (message "Colors will be printed"))
+         (setq mh-ps-print-color-option t)
+         (message "Colors will be printed"))
      (setq mh-ps-print-color-option nil)
      (message "Colors will not be printed"))))