Mercurial > emacs

--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/lisp/mh-e/mh-acros.el	Mon Aug 16 02:55:02 2004 +0000
@@ -0,0 +1,142 @@
+;;; mh-acros.el --- Macros used in MH-E
+
+;; Copyright (C) 2004 Free Software Foundation, Inc.
+
+;; Author: Satyaki Das <satyaki@theforce.stanford.edu>
+;; Maintainer: Bill Wohler <wohler@newt.com>
+;; Keywords: mail
+;; See: mh-e.el
+
+;; This file is part of GNU Emacs.
+
+;; 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.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; 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., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;; This file contains macros that would normally be in mh-utils.el except that
+;; their presence there would cause a dependency loop with mh-customize.el.
+;; This file must always be included like this:
+;;
+;;   (eval-when-compile (require 'mh-acros))
+;;
+;; It is so named with a silent `m' so that it is compiled first. Otherwise,
+;; "make recompile" in Emacs 21.4 fails.
+
+;;; Change Log:
+
+;;; Code:
+
+(require 'cl)
+
+;; The Emacs coding conventions require that the cl package not be required at
+;; runtime. However, the cl package in versions of Emacs prior to 21.4 left cl
+;; routines in their macro expansions. Use mh-require-cl to provide the cl
+;; routines in the best way possible.
+(defmacro mh-require-cl ()
+  "Macro to load `cl' if needed.
+Some versions of `cl' produce code for the expansion of
+\(setf (gethash ...) ...) that uses functions in `cl' at run time.  This macro
+recognizes that and loads `cl' where appropriate."
+  (if (eq (car (macroexpand '(setf (gethash foo bar) baz))) 'cl-puthash)
+      `(progn
+         (require 'cl)
+         ;; Autoloads of CL functions go here...
+         (autoload 'cl-puthash "cl")
+         (autoload 'values "cl")
+         (autoload 'copy-tree "cl"))
+    `(eval-when-compile (require 'cl))))
+
+;;; Macros to generate correct code for different emacs variants
+
+(defmacro mh-do-in-gnu-emacs (&rest body)
+  "Execute BODY if in GNU Emacs."
+  (unless (featurep 'xemacs) `(progn ,@body)))
+(put 'mh-do-in-gnu-emacs 'lisp-indent-hook 'defun)
+
+(defmacro mh-do-in-xemacs (&rest body)
+  "Execute BODY if in GNU Emacs."
+  (when (featurep 'xemacs) `(progn ,@body)))
+(put 'mh-do-in-xemacs 'lisp-indent-hook 'defun)
+
+(defmacro mh-funcall-if-exists (function &rest args)
+  "Call FUNCTION with ARGS as parameters if it exists."
+  (if (fboundp function)
+      `(funcall ',function ,@args)))
+
+(defmacro mh-make-local-hook (hook)
+  "Make HOOK local if needed.
+XEmacs and versions of GNU Emacs before 21.1 require `make-local-hook' to be
+called."
+  (when (and (fboundp 'make-local-hook)
+             (not (get 'make-local-hook 'byte-obsolete-info)))
+    `(make-local-hook ,hook)))
+
+(defmacro mh-mark-active-p (check-transient-mark-mode-flag)
+  "A macro that expands into appropriate code in XEmacs and nil in GNU Emacs.
+In GNU Emacs if CHECK-TRANSIENT-MARK-MODE-FLAG is non-nil then check if
+variable `transient-mark-mode' is active."
+  (cond ((featurep 'xemacs)             ;XEmacs
+         `(and (boundp 'zmacs-regions) zmacs-regions (region-active-p)))
+        ((not check-transient-mark-mode-flag) ;GNU Emacs
+         `(and (boundp 'mark-active) mark-active))
+        (t                              ;GNU Emacs
+         `(and (boundp 'transient-mark-mode) transient-mark-mode
+               (boundp 'mark-active) mark-active))))
+
+(defmacro mh-defstruct (name-spec &rest fields)
+  "Replacement for `defstruct' from the `cl' package.
+The `defstruct' in the `cl' library produces compiler warnings, and generates
+code that uses functions present in `cl' at run-time.  This is a partial
+replacement, that avoids these issues.
+
+NAME-SPEC declares the name of the structure, while FIELDS describes the
+various structure fields. Lookup `defstruct' for more details."
+  (let* ((struct-name (if (atom name-spec) name-spec (car name-spec)))
+         (conc-name (or (and (consp name-spec)
+                             (cadr (assoc :conc-name (cdr name-spec))))
+                        (format "%s-" struct-name)))
+         (predicate (intern (format "%s-p" struct-name)))
+         (constructor (or (and (consp name-spec)
+                               (cadr (assoc :constructor (cdr name-spec))))
+                          (intern (format "make-%s" struct-name))))
+         (field-names (mapcar #'(lambda (x) (if (atom x) x (car x))) fields))
+         (field-init-forms (mapcar #'(lambda (x) (and (consp x) (cadr x)))
+                                   fields))
+         (struct (gensym "S"))
+         (x (gensym "X"))
+         (y (gensym "Y")))
+    `(progn
+       (defun* ,constructor (&key ,@(mapcar* #'(lambda (x y) (list x y))
+                                             field-names field-init-forms))
+         (list ,@field-names))
+       (defun ,predicate (arg)
+         (and (consp arg) (eql (length arg) ,(length fields))))
+       ,@(loop for x from 0
+               for y in field-names
+               collect `(defmacro ,(intern (format "%s%s" conc-name y)) (z)
+                          (list 'nth ,x z)))
+       (quote ,struct-name))))
+
+
+(provide 'mh-acros)
+
+;;; Local Variables:
+;;; no-byte-compile: t
+;;; indent-tabs-mode: nil
+;;; sentence-end-double-space: nil
+;;; End:
+
+;;; mh-acros.el ends here
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/lisp/mh-e/mh-init.el	Mon Aug 16 02:55:02 2004 +0000
@@ -0,0 +1,307 @@
+;;; mh-init.el --- MH-E initialization.
+
+;; Copyright (C) 2003, 2004 Free Software Foundation, Inc.
+
+;; Author: Peter S. Galbraith <psg@debian.org>
+;; Maintainer: Bill Wohler <wohler@newt.com>
+;; Keywords: mail
+;; See: mh-e.el
+
+;; This file is part of GNU Emacs.
+
+;; 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.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; 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., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;; Sets up the MH variant (currently nmh or MH).
+;;
+;; Users may customize `mh-variant' to switch between available variants.
+;; Available MH variants are described in the variable `mh-variants'.
+;; Developers may check which variant is currently in use with the
+;; variable `mh-variant-in-use' or the function `mh-variant-p'.
+
+;;; Change Log:
+
+;;; Code:
+
+(eval-when-compile (require 'mh-acros))
+(mh-require-cl)
+(require 'mh-utils)
+
+;;; Set for local environment:
+;;; mh-progs and mh-lib used to be set in paths.el, which tried to
+;;; figure out at build time which of several possible directories MH
+;;; was installed into.  But if you installed MH after building Emacs,
+;;; this would almost certainly be wrong, so now we do it at run time.
+
+(defvar mh-progs nil
+  "Directory containing MH commands, such as inc, repl, and rmm.")
+
+(defvar mh-lib nil
+  "Directory containing the MH library.
+This directory contains, among other things, the components file.")
+
+(defvar mh-lib-progs nil
+  "Directory containing MH helper programs.
+This directory contains, among other things, the mhl program.")
+
+(defvar mh-flists-present-flag nil
+  "Non-nil means that we have `flists'.")
+
+;;;###autoload
+(put 'mh-progs 'risky-local-variable t)
+;;;###autoload
+(put 'mh-lib 'risky-local-variable t)
+;;;###autoload
+(put 'mh-lib-progs 'risky-local-variable t)
+
+(defvar mh-variant-in-use nil
+  "The MH variant currently in use; a string with variant and version number.
+This differs from `mh-variant' when the latter is set to `autodetect'.")
+
+;;;###mh-autoload
+(defun mh-variant-set (variant)
+  "Set the MH variant to VARIANT.
+Sets `mh-progs', `mh-lib', `mh-lib-progs' and `mh-flists-present-flag'.
+If the VARIANT is `autodetect', then first try nmh, then MH and finally
+GNU mailutils."
+  (interactive
+   (list (completing-read
+          "MH Variant: "
+          (mapcar (lambda (x) (list (car x))) (mh-variants))
+          nil t)))
+  (let ((valid-list (mapcar (lambda (x) (car x)) (mh-variants))))
+    (cond
+     ((eq variant 'none))
+     ((eq variant 'autodetect)
+      (cond
+       ((mh-variant-set-variant 'nmh)
+        (message "%s installed as MH variant" mh-variant-in-use))
+       ((mh-variant-set-variant 'MH)
+        (message "%s installed as MH variant" mh-variant-in-use))
+       ((mh-variant-set-variant 'mu-mh)
+        (message "%s installed as MH variant" mh-variant-in-use))
+       (t
+        (message "No MH variant found on the system!"))))
+     ((member variant valid-list)
+      (when (not (mh-variant-set-variant variant))
+        (message "Warning: %s variant not found.  Autodetecting..." variant)
+        (mh-variant-set 'autodetect)))
+     (t
+      (message "Unknown variant.  Use %s"
+               (mapconcat '(lambda (x) (format "%s" (car x)))
+                          mh-variants " or "))))))
+
+(defun mh-variant-set-variant (variant)
+  "Setup the system variables for the MH variant named VARIANT.
+If VARIANT is a string, use that key in the variable `mh-variants'.
+If VARIANT is a symbol, select the first entry that matches that variant."
+  (cond
+   ((stringp variant)                   ;e.g. "nmh 1.1-RC1"
+    (when (assoc variant mh-variants)
+      (let* ((alist (cdr (assoc variant mh-variants)))
+             (lib-progs (cadr (assoc 'mh-lib-progs alist)))
+             (lib       (cadr (assoc 'mh-lib       alist)))
+             (progs     (cadr (assoc 'mh-progs     alist)))
+             (flists    (cadr (assoc 'flists       alist))))
+        ;;(set-default mh-variant variant)
+        (setq mh-x-mailer-string     nil
+              mh-flists-present-flag flists
+              mh-lib-progs           lib-progs
+              mh-lib                 lib
+              mh-progs               progs
+              mh-variant-in-use      variant))))
+   ((symbolp variant)                   ;e.g. 'nmh (pick the first match)
+    (loop for variant-list in mh-variants
+          when (eq variant (cadr (assoc 'variant (cdr variant-list))))
+          return (let* ((version   (car variant-list))
+                        (alist (cdr variant-list))
+                        (lib-progs (cadr (assoc 'mh-lib-progs alist)))
+                        (lib       (cadr (assoc 'mh-lib       alist)))
+                        (progs     (cadr (assoc 'mh-progs     alist)))
+                        (flists    (cadr (assoc 'flists       alist))))
+                   ;;(set-default mh-variant flavor)
+                   (setq mh-x-mailer-string     nil
+                         mh-flists-present-flag flists
+                         mh-lib-progs           lib-progs
+                         mh-lib                 lib
+                         mh-progs               progs
+                         mh-variant-in-use      version)
+                   t)))))
+
+;;;###mh-autoload
+(defun mh-variant-p (&rest variants)
+  "Return t if variant is any of VARIANTS.
+Currently known variants are 'mh and 'nmh."
+  (let ((variant-in-use
+         (cadr (assoc 'variant (assoc mh-variant-in-use mh-variants)))))
+    (not (null (member variant-in-use variants)))))
+
+(defvar mh-sys-path
+  '("/usr/local/nmh/bin"                ; nmh default
+    "/usr/local/bin/mh/"
+    "/usr/local/mh/"
+    "/usr/bin/mh/"                      ; Ultrix 4.2, Linux
+    "/usr/new/mh/"                      ; Ultrix < 4.2
+    "/usr/contrib/mh/bin/"              ; BSDI
+    "/usr/pkg/bin/"                     ; NetBSD
+    "/usr/local/bin/"
+    "/usr/local/bin/mu-mh/"             ; GNU mailutils - default
+    "/usr/bin/mu-mh/")                  ; GNU mailutils - packaged
+  "List of directories to search for variants of the MH variant.
+The list `exec-path' is searched in addition to this list.
+There's no need for users to modify this list.  Instead add extra
+directories to the customizable variable `mh-path'.")
+
+(defcustom mh-path nil
+  "*List of directories to search for variants of the MH variant.
+The directories will be searched for `mhparam' in addition to directories
+listed in `mh-sys-path' and `exec-path'."
+  :group 'mh
+  :type '(repeat (directory)))
+
+(defvar mh-variants nil
+  "List describing known MH variants.
+Created by the function `mh-variants'")
+
+(defun mh-variant-mh-info (dir)
+  "Return info for MH variant in DIR assuming a temporary buffer is setup."
+  ;; MH does not have the -version option.
+  ;; Its version number is included in the output of `-help' as:
+  ;;
+  ;; version: MH 6.8.4 #2[UCI] (burrito) of Fri Jan 15 20:01:39 EST 1999
+  ;; options: [ATHENA] [BIND] [DUMB] [LIBLOCKFILE] [LOCALE] [MAILGROUP] [MHE]
+  ;;          [MHRC] [MIME] [MORE='"/usr/bin/sensible-pager"'] [NLINK_HACK]
+  ;;          [NORUSERPASS] [OVERHEAD] [POP] [POPSERVICE='"pop-3"'] [RENAME]
+  ;;          [RFC1342] [RPATHS] [RPOP] [SENDMTS] [SMTP] [SOCKETS]
+  ;;          [SPRINTFTYPE=int] [SVR4] [SYS5] [SYS5DIR] [TERMINFO]
+  ;;          [TYPESIG=void] [UNISTD] [UTK] [VSPRINTF]
+  (let ((mhparam (expand-file-name "mhparam" dir)))
+    (when (and (file-exists-p mhparam) (file-executable-p mhparam))
+      (erase-buffer)
+      (call-process mhparam nil '(t nil) nil "-help")
+      (goto-char (point-min))
+      (when (search-forward-regexp "version: MH \\(\\S +\\)" nil t)
+        (let ((version (format "MH %s" (match-string 1))))
+          (erase-buffer)
+          (call-process mhparam nil '(t nil) nil "libdir")
+          (goto-char (point-min))
+          (when (search-forward-regexp "^.*$" nil t)
+            (let ((libdir (match-string 0)))
+              `(,version
+                (variant        mh)
+                (mh-lib-progs   ,libdir)
+                (mh-lib         ,libdir)
+                (mh-progs       ,dir)
+                (flists         nil)))))))))
+
+(defun mh-variant-mu-mh-info (dir)
+  "Return info for GNU mailutils variant in DIR.
+This assumes that a temporary buffer is setup."
+  ;; 'mhparam -version' output:
+  ;; mhparam (GNU mailutils 0.3.2)
+  (let ((mhparam (expand-file-name "mhparam" dir)))
+    (when (and (file-exists-p mhparam) (file-executable-p mhparam))
+      (erase-buffer)
+      (call-process mhparam nil '(t nil) nil "-version")
+      (goto-char (point-min))
+      (when (search-forward-regexp "mhparam (\\(GNU [Mm]ailutils \\S +\\))"
+                                   nil t)
+        (let ((version (match-string 1)))
+          (erase-buffer)
+          (call-process mhparam nil '(t nil) nil "libdir" "etcdir")
+          (goto-char (point-min))
+          (when (search-forward-regexp "^libdir:\\s-\\(\\S-+\\)\\s-*$" nil t)
+            (let ((libdir (match-string 1)))
+              (goto-char (point-min))
+              (when (search-forward-regexp
+                     "^etcdir:\\s-\\(\\S-+\\)\\s-*$" nil t)
+                (let ((etcdir (match-string 1))
+                      (flists (file-exists-p (expand-file-name "flists" dir))))
+                  `(,version
+                    (variant        mu-mh)
+                    (mh-lib-progs   ,libdir)
+                    (mh-lib         ,etcdir)
+                    (mh-progs       ,dir)
+                    (flists         ,flists)))))))))))
+
+(defun mh-variant-nmh-info (dir)
+  "Return info for nmh variant in DIR assuming a temporary buffer is setup."
+  ;; `mhparam -version' outputs:
+  ;; mhparam -- nmh-1.1-RC1 [compiled on chaak at Fri Jun 20 11:03:28 PDT 2003]
+  (let ((mhparam (expand-file-name "mhparam" dir)))
+    (when (and (file-exists-p mhparam) (file-executable-p mhparam))
+      (erase-buffer)
+      (call-process mhparam nil '(t nil) nil "-version")
+      (goto-char (point-min))
+      (when (search-forward-regexp "mhparam -- nmh-\\(\\S +\\)" nil t)
+        (let ((version (format "nmh %s" (match-string 1))))
+          (erase-buffer)
+          (call-process mhparam nil '(t nil) nil "libdir" "etcdir")
+          (goto-char (point-min))
+          (when (search-forward-regexp "^libdir:\\s-\\(\\S-+\\)\\s-*$" nil t)
+            (let ((libdir (match-string 1)))
+              (goto-char (point-min))
+              (when (search-forward-regexp
+                     "^etcdir:\\s-\\(\\S-+\\)\\s-*$" nil t)
+                (let ((etcdir (match-string 1))
+                      (flists (file-exists-p (expand-file-name "flists" dir))))
+                  `(,version
+                    (variant        nmh)
+                    (mh-lib-progs   ,libdir)
+                    (mh-lib         ,etcdir)
+                    (mh-progs       ,dir)
+                    (flists         ,flists)))))))))))
+
+(defun mh-variant-info (dir)
+  "Return MH variant found in DIR, or nil if none present."
+  (save-excursion
+    (let ((tmp-buffer (get-buffer-create mh-temp-buffer)))
+      (set-buffer tmp-buffer)
+      (cond
+       ((mh-variant-mh-info dir))
+       ((mh-variant-nmh-info dir))
+       ((mh-variant-mu-mh-info dir))))))
+
+;;;###mh-autoload
+(defun mh-variants ()
+  "Return a list of installed variants of MH on the system.
+This function looks for MH in `mh-sys-path', `mh-path' and
+`exec-path'. The format of the list of variants that is returned is described
+by the variable `mh-variants'."
+  (if mh-variants
+      mh-variants
+    (let ((list-unique))
+      ;; Make a unique list of directories, keeping the given order.
+      ;; We don't want the same MH variant to be listed multiple times.
+      (loop for dir in (append mh-path mh-sys-path exec-path) do
+            (setq dir (file-chase-links (directory-file-name dir)))
+            (add-to-list 'list-unique dir))
+      (loop for dir in (nreverse list-unique) do
+            (when (and dir (file-directory-p dir) (file-readable-p dir))
+              (let ((variant (mh-variant-info dir)))
+                (if variant
+                    (add-to-list 'mh-variants variant)))))
+      mh-variants)))
+
+(provide 'mh-init)
+
+;;; Local Variables:
+;;; indent-tabs-mode: nil
+;;; sentence-end-double-space: nil
+;;; End:
+
+;;; mh-init.el ends here
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/lisp/mh-e/mh-print.el	Mon Aug 16 02:55:02 2004 +0000
@@ -0,0 +1,278 @@
+;;; mh-print.el --- MH-E printing support
+
+;; Copyright (C) 2003, 2004 Free Software Foundation, Inc.
+
+;; Author: Jeffrey C Honig <jch@honig.net>
+;; Maintainer: Bill Wohler <wohler@newt.com>
+;; Keywords: mail
+;; See: mh-e.el
+
+;; This file is part of GNU Emacs.
+
+;; 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.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; 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., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+;;	Pp	Print to lpr              |   Default inline settings
+;;      Pf      Print to file             |   Generate a postscript file
+;;	Ps	Print show buffer         |   Fails if no show buffer
+;;
+;;	PA	Toggle inline/attachments
+;;	PC	Toggle color
+;;	PF	Toggle faces
+
+;;; Change Log:
+
+;;; Code:
+
+(eval-when-compile (require 'mh-acros))
+(mh-require-cl)
+(require 'ps-print)
+(require 'mh-utils)
+(require 'mh-funcs)
+(eval-when-compile (require 'mh-seq))
+
+(defvar mh-ps-print-mime nil
+  "Control printing of MIME parts.
+The three possible states are:
+  1. nil to not print inline parts
+  2. t to print inline parts
+  3. non-zero to print inline parts and attachments")
+
+(defvar mh-ps-print-color-option ps-print-color-p
+  "MH-E's version of `\\[ps-print-color-p]'.")
+
+(defvar mh-ps-print-func 'ps-spool-buffer-with-faces
+  "Function to use to spool a buffer.
+Sensible choices are the functions `ps-spool-buffer' and
+`ps-spool-buffer-with-faces'.")
+
+;; XXX - If buffer is already being displayed, use that buffer
+;; XXX - What about showing MIME content?
+;; XXX - Default print buffer is bogus
+(defun mh-ps-spool-buffer (buffer)
+  "Send BUFFER to printer queue."
+  (message (format "mh-ps-spool-buffer %s" 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-a-msg (msg buffer)
+  "Print MSG.
+First the message is decoded in BUFFER before the results are sent to the
+printer."
+  (message (format "mh-ps-spool-a-msg msg %s buffer %s"
+		   msg buffer))
+  (let ((mh-show-buffer mh-show-buffer)
+	(folder mh-current-folder)
+        ;; The following is commented out because
+        ;; `clean-message-header-flag' isn't used anywhere. I
+        ;; commented rather than deleted in case somebody had some
+        ;; future plans for it. --SY.
+	;(clean-message-header-flag mh-clean-message-header-flag)
+        )
+    (unwind-protect
+	(progn
+	  (setq mh-show-buffer buffer)
+	  (save-excursion
+	    ;;
+	    ;; XXX - Use setting of mh-ps-print-mime
+	    ;;
+	    (mh-display-msg msg folder)
+	    (mh-ps-spool-buffer mh-show-buffer)
+      (kill-buffer mh-show-buffer))))))
+
+;;;###mh-autoload
+(defun mh-ps-print-msg (range)
+  "Print the messages in RANGE.
+
+Check the documentation of `mh-interactive-range' to see how RANGE is read in
+interactive use."
+  (interactive (list (mh-interactive-range "Print")))
+  (message (format "mh-ps-print-msg range %s keys %s"
+		    range (this-command-keys)))
+  (mh-iterate-on-range msg range
+    (let ((buffer (get-buffer-create mh-temp-buffer)))
+      (unwind-protect
+	  (mh-ps-spool-a-msg msg buffer)
+	(kill-buffer buffer)))
+    (mh-notate nil mh-note-printed mh-cmd-note))
+  (ps-despool nil))
+
+(defun mh-ps-print-preprint (prefix-arg)
+  "Replacement for `ps-print-preprint'.
+The original function does not handle the fact that MH folders are directories
+nicely, when generating the default file name. This function works around
+that. The function is passed the interactive PREFIX-ARG."
+  (let ((buffer-file-name (format "/tmp/%s" (substring (buffer-name) 1))))
+    (ps-print-preprint prefix-arg)))
+
+;;;###mh-autoload
+(defun mh-ps-print-msg-file (file range)
+  "Print to FILE the messages in RANGE.
+
+Check the documentation of `mh-interactive-range' to see how RANGE is read in
+interactive use."
+  (interactive (list
+		(mh-ps-print-preprint 1)
+		(mh-interactive-range "Print")))
+  (mh-iterate-on-range msg range
+    (let ((buffer (get-buffer-create mh-temp-buffer)))
+      (unwind-protect
+	  (mh-ps-spool-a-msg msg buffer)
+	(kill-buffer buffer)))
+    (mh-notate nil mh-note-printed mh-cmd-note))
+  (ps-despool file))
+
+;;;###mh-autoload
+(defun mh-ps-print-msg-show (file)
+  "Print current show buffer to FILE."
+  (interactive (list (mh-ps-print-preprint current-prefix-arg)))
+  (message (format "mh-ps-print-msg-show file %s keys %s mh-show-buffer %s"
+		   file (this-command-keys) mh-show-buffer))
+  (let ((msg (mh-get-msg-num t))
+        (folder mh-current-folder)
+        (show-buffer mh-show-buffer)
+        (show-window (get-buffer-window mh-show-buffer)))
+    (if (and show-buffer show-window)
+	(mh-in-show-buffer (show-buffer)
+	  (if (equal (mh-msg-filename msg folder) buffer-file-name)
+	      (progn
+		(mh-ps-spool-buffer show-buffer)
+		(ps-despool file))
+	    (message "Current message is not being shown(1).")))
+      (message "Current message is not being shown(2)."))))
+
+;;;###mh-autoload
+(defun mh-ps-print-toggle-faces ()
+ "Toggle whether printing is done with faces or not."
+ (interactive)
+ (if (eq mh-ps-print-func 'ps-spool-buffer-with-faces)
+     (progn
+       (setq mh-ps-print-func 'ps-spool-buffer)
+       (message "Printing without faces"))
+   (setq mh-ps-print-func 'ps-spool-buffer-with-faces)
+   (message "Printing with faces")))
+
+;;;###mh-autoload
+(defun mh-ps-print-toggle-color ()
+  "Toggle whether color is used in printing messages."
+ (interactive)
+ (if (eq mh-ps-print-color-option nil)
+     (progn
+       (setq mh-ps-print-color-option 'black-white)
+       (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 nil)
+     (message "Colors will not be printed."))))
+
+;;; XXX: Check option 3. Documentation doesn't sound right.
+;;;###mh-autoload
+(defun mh-ps-print-toggle-mime ()
+  "Cycle through available choices on how MIME parts should be printed.
+The available settings are:
+  1. Print only inline MIME parts.
+  2. Print all MIME parts.
+  3. Print no MIME parts."
+  (interactive)
+  (if (eq mh-ps-print-mime nil)
+      (progn
+        (setq mh-ps-print-mime t)
+        (message "Inline parts will be printed, attachments will not be printed."))
+    (if (eq mh-ps-print-mime t)
+        (progn
+          (setq mh-ps-print-mime 1)
+          (message "Both Inline parts and attachments will be printed."))
+      (setq mh-ps-print-mime nil)
+      (message "Neither inline parts nor attachments will be printed."))))
+
+;;; Old non-PS based printing
+;;;###mh-autoload
+(defun mh-print-msg (range)
+  "Print RANGE on printer.
+
+Check the documentation of `mh-interactive-range' to see how RANGE is read in
+interactive use.
+
+The variable `mh-lpr-command-format' is used to generate the print command.
+The messages are formatted by mhl. See the variable `mhl-formfile'."
+  (interactive (list (mh-interactive-range "Print")))
+  (message "Printing...")
+  (let (msgs)
+    ;; Gather message numbers and add them to "printed" sequence.
+    (mh-iterate-on-range msg range
+      (mh-add-msgs-to-seq msg 'printed t)
+      (mh-notate nil mh-note-printed mh-cmd-note)
+      (push msg msgs))
+    (setq msgs (nreverse msgs))
+    ;; Print scan listing if we have more than one message.
+    (if (> (length msgs) 1)
+        (let* ((msgs-string
+                (mapconcat 'identity (mh-list-to-string
+                                      (mh-coalesce-msg-list msgs)) " "))
+               (lpr-command
+                (format mh-lpr-command-format
+                        (cond ((listp range)
+                               (format "Folder: %s, Messages: %s"
+                                       mh-current-folder msgs-string))
+                              ((symbolp range)
+                               (format "Folder: %s, Sequence: %s"
+                                       mh-current-folder range)))))
+               (scan-command
+                (format "scan %s | %s" msgs-string lpr-command)))
+          (if mh-print-background-flag
+              (mh-exec-cmd-daemon shell-file-name nil "-c" scan-command)
+            (call-process shell-file-name nil nil nil "-c" scan-command))))
+    ;; Print the messages
+    (dolist (msg msgs)
+      (let* ((mhl-command (format "%s %s %s"
+                                  (expand-file-name "mhl" mh-lib-progs)
+                                  (if mhl-formfile
+                                      (format " -form %s" mhl-formfile)
+                                    "")
+                                  (mh-msg-filename msg)))
+             (lpr-command
+              (format mh-lpr-command-format
+                      (format "%s/%s" mh-current-folder msg)))
+             (print-command
+              (format "%s | %s" mhl-command lpr-command)))
+        (if mh-print-background-flag
+            (mh-exec-cmd-daemon shell-file-name nil "-c" print-command)
+          (call-process shell-file-name nil nil nil "-c" print-command)))))
+  (message "Printing...done"))
+
+(provide 'mh-print)
+
+;;; Local Variables:
+;;; indent-tabs-mode: nil
+;;; sentence-end-double-space: nil
+;;; End:
+
+;;; mh-print.el ends here