diff options
| -rw-r--r-- | lisp/mh-e/mh-acros.el | 142 | ||||
| -rw-r--r-- | lisp/mh-e/mh-init.el | 307 | ||||
| -rw-r--r-- | lisp/mh-e/mh-print.el | 278 |
3 files changed, 727 insertions, 0 deletions
diff --git a/lisp/mh-e/mh-acros.el b/lisp/mh-e/mh-acros.el new file mode 100644 index 00000000000..e07eb6e4ed1 --- /dev/null +++ b/lisp/mh-e/mh-acros.el @@ -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 diff --git a/lisp/mh-e/mh-init.el b/lisp/mh-e/mh-init.el new file mode 100644 index 00000000000..7011070a2d8 --- /dev/null +++ b/lisp/mh-e/mh-init.el @@ -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 diff --git a/lisp/mh-e/mh-print.el b/lisp/mh-e/mh-print.el new file mode 100644 index 00000000000..83feae3c528 --- /dev/null +++ b/lisp/mh-e/mh-print.el @@ -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 |