[bpt/emacs.git] / lisp / mh-e / mh-init.el

;;; 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., 51 Franklin Street, Fifth Floor,
;; Boston, MA 02110-1301, 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)

;;; Avoid compiler warnings.
(eval-when-compile (defvar image-load-path))

;;; 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, 'nmh, and 'mu-mh."
  (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-e
  :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)))

;;; XXX The two calls to message in this function should really be calls to
;;; error. However, when this function is compiled via the top-level call in
;;; mh-customize.el, it is actually called, and in a compile environment, the
;;; errors are triggered which botches the compile. As a workaround, the calls
;;; to error have been changed to calls to message, and code following was
;;; inserted as an else clause. This is not robust, so if you can fix this,
;;; please do!
;;;###mh-autoload
(defun mh-image-load-path ()
  "Ensure that the MH-E images are accessible by `find-image'.
Images for MH-E are found in ../../etc/images relative to the files in
`lisp/mh-e'. If `image-load-path' exists (since Emacs 22), then the images
directory is added to it if isn't already there. Otherwise, the images
directory is added to the `load-path' if it isn't already there."
  (let (mh-load-path mh-image-load-path)
    ;; First, find mh-e in the load-path.
    (let ((path load-path))
      (while path
        (let* ((directory (directory-file-name (car path))))
          (setq mh-load-path
                (if (and (equal (file-name-nondirectory directory) "mh-e")
                         (file-exists-p directory))
                    directory
                  nil))
          (setq path (if mh-load-path nil (cdr path)))))
      (if (not mh-load-path)
          ;; This message be error; there shouldn't be an else. Blame compiler.
          (message "Can not find mh-e in load-path (OK when compiling)")
        ;; Create the image path associated with this mh-e directory.
        (setq mh-image-load-path (expand-file-name
                                  (concat (file-name-directory mh-load-path)
                                          "../etc/images")))))
    (if (or (not mh-image-load-path)
            (not (file-exists-p mh-image-load-path)))
        ;; This message be error; there shouldn't be an else. Blame compiler.
        (message "Can not find image directory %s (OK when compiling)"
                 mh-image-load-path)
      ;; If image-load-path exists, and the image path isn't there add it.
      (if (boundp 'image-load-path)
          (if (not (member mh-image-load-path image-load-path))
              (push mh-image-load-path image-load-path))
        ;; Otherwise, if the image path isn't in the load-path, add it there.
        (if (not (member mh-image-load-path load-path))
            (push mh-image-load-path load-path))))))

(provide 'mh-init)

;;; Local Variables:
;;; indent-tabs-mode: nil
;;; sentence-end-double-space: nil
;;; End:

;; arch-tag: e8372aeb-d803-42b1-9c95-3c93ad22f63c
;;; mh-init.el ends here
Commit	Line	Data
863e5e39 BW	1	;;; mh-init.el --- MH-E initialization.
863e5e39 BW	2
e495eaec	3	;; Copyright (C) 2003, 2004 Free Software Foundation, Inc.
863e5e39 BW	4
	5	;; Author: Peter S. Galbraith <psg@debian.org>
	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
3a35cf56 LK	24	;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
3a35cf56 LK	25	;; Boston, MA 02110-1301, USA.
863e5e39 BW	26
	27	;;; Commentary:
	28
	29	;; Sets up the MH variant (currently nmh or MH).
	30	;;
	31	;; Users may customize `mh-variant' to switch between available variants.
	32	;; Available MH variants are described in the variable `mh-variants'.
	33	;; Developers may check which variant is currently in use with the
	34	;; variable `mh-variant-in-use' or the function `mh-variant-p'.
	35
	36	;;; Change Log:
	37
	38	;;; Code:
	39
	40	(eval-when-compile (require 'mh-acros))
	41	(mh-require-cl)
	42	(require 'mh-utils)
	43
a05fcb7d BW	44	;;; Avoid compiler warnings.
	45	(eval-when-compile (defvar image-load-path))
	46
863e5e39 BW	47	;;; Set for local environment:
	48	;;; mh-progs and mh-lib used to be set in paths.el, which tried to
	49	;;; figure out at build time which of several possible directories MH
	50	;;; was installed into. But if you installed MH after building Emacs,
	51	;;; this would almost certainly be wrong, so now we do it at run time.
	52
	53	(defvar mh-progs nil
	54	"Directory containing MH commands, such as inc, repl, and rmm.")
	55
	56	(defvar mh-lib nil
	57	"Directory containing the MH library.
	58	This directory contains, among other things, the components file.")
	59
	60	(defvar mh-lib-progs nil
	61	"Directory containing MH helper programs.
	62	This directory contains, among other things, the mhl program.")
	63
	64	(defvar mh-flists-present-flag nil
	65	"Non-nil means that we have `flists'.")
	66
	67	;;;###autoload
	68	(put 'mh-progs 'risky-local-variable t)
	69	;;;###autoload
	70	(put 'mh-lib 'risky-local-variable t)
	71	;;;###autoload
	72	(put 'mh-lib-progs 'risky-local-variable t)
	73
	74	(defvar mh-variant-in-use nil
	75	"The MH variant currently in use; a string with variant and version number.
	76	This differs from `mh-variant' when the latter is set to `autodetect'.")
	77
	78	;;;###mh-autoload
	79	(defun mh-variant-set (variant)
	80	"Set the MH variant to VARIANT.
	81	Sets `mh-progs', `mh-lib', `mh-lib-progs' and `mh-flists-present-flag'.
	82	If the VARIANT is `autodetect', then first try nmh, then MH and finally
	83	GNU mailutils."
	84	(interactive
	85	(list (completing-read
	86	"MH Variant: "
	87	(mapcar (lambda (x) (list (car x))) (mh-variants))
	88	nil t)))
	89	(let ((valid-list (mapcar (lambda (x) (car x)) (mh-variants))))
	90	(cond
	91	((eq variant 'none))
	92	((eq variant 'autodetect)
	93	(cond
	94	((mh-variant-set-variant 'nmh)
	95	(message "%s installed as MH variant" mh-variant-in-use))
eccf9613	96	((mh-variant-set-variant 'mh)
863e5e39 BW	97	(message "%s installed as MH variant" mh-variant-in-use))
	98	((mh-variant-set-variant 'mu-mh)
	99	(message "%s installed as MH variant" mh-variant-in-use))
	100	(t
	101	(message "No MH variant found on the system!"))))
	102	((member variant valid-list)
	103	(when (not (mh-variant-set-variant variant))
	104	(message "Warning: %s variant not found. Autodetecting..." variant)
	105	(mh-variant-set 'autodetect)))
	106	(t
	107	(message "Unknown variant. Use %s"
	108	(mapconcat '(lambda (x) (format "%s" (car x)))
	109	mh-variants " or "))))))
	110
	111	(defun mh-variant-set-variant (variant)
	112	"Setup the system variables for the MH variant named VARIANT.
	113	If VARIANT is a string, use that key in the variable `mh-variants'.
	114	If VARIANT is a symbol, select the first entry that matches that variant."
	115	(cond
	116	((stringp variant) ;e.g. "nmh 1.1-RC1"
	117	(when (assoc variant mh-variants)
	118	(let* ((alist (cdr (assoc variant mh-variants)))
	119	(lib-progs (cadr (assoc 'mh-lib-progs alist)))
	120	(lib (cadr (assoc 'mh-lib alist)))
	121	(progs (cadr (assoc 'mh-progs alist)))
	122	(flists (cadr (assoc 'flists alist))))
	123	;;(set-default mh-variant variant)
	124	(setq mh-x-mailer-string nil
	125	mh-flists-present-flag flists
	126	mh-lib-progs lib-progs
	127	mh-lib lib
	128	mh-progs progs
	129	mh-variant-in-use variant))))
	130	((symbolp variant) ;e.g. 'nmh (pick the first match)
	131	(loop for variant-list in mh-variants
	132	when (eq variant (cadr (assoc 'variant (cdr variant-list))))
	133	return (let* ((version (car variant-list))
	134	(alist (cdr variant-list))
	135	(lib-progs (cadr (assoc 'mh-lib-progs alist)))
	136	(lib (cadr (assoc 'mh-lib alist)))
	137	(progs (cadr (assoc 'mh-progs alist)))
	138	(flists (cadr (assoc 'flists alist))))
	139	;;(set-default mh-variant flavor)
	140	(setq mh-x-mailer-string nil
	141	mh-flists-present-flag flists
	142	mh-lib-progs lib-progs
	143	mh-lib lib
	144	mh-progs progs
	145	mh-variant-in-use version)
	146	t)))))
	147
	148	;;;###mh-autoload
	149	(defun mh-variant-p (&rest variants)
	150	"Return t if variant is any of VARIANTS.
eccf9613	151	Currently known variants are 'MH, 'nmh, and 'mu-mh."
863e5e39 BW	152	(let ((variant-in-use
	153	(cadr (assoc 'variant (assoc mh-variant-in-use mh-variants)))))
	154	(not (null (member variant-in-use variants)))))
	155
	156	(defvar mh-sys-path
	157	'("/usr/local/nmh/bin" ; nmh default
	158	"/usr/local/bin/mh/"
	159	"/usr/local/mh/"
	160	"/usr/bin/mh/" ; Ultrix 4.2, Linux
	161	"/usr/new/mh/" ; Ultrix < 4.2
	162	"/usr/contrib/mh/bin/" ; BSDI
	163	"/usr/pkg/bin/" ; NetBSD
	164	"/usr/local/bin/"
	165	"/usr/local/bin/mu-mh/" ; GNU mailutils - default
	166	"/usr/bin/mu-mh/") ; GNU mailutils - packaged
	167	"List of directories to search for variants of the MH variant.
	168	The list `exec-path' is searched in addition to this list.
	169	There's no need for users to modify this list. Instead add extra
	170	directories to the customizable variable `mh-path'.")
	171
	172	(defcustom mh-path nil
	173	"*List of directories to search for variants of the MH variant.
	174	The directories will be searched for `mhparam' in addition to directories
	175	listed in `mh-sys-path' and `exec-path'."
a05fcb7d	176	:group 'mh-e
863e5e39 BW	177	:type '(repeat (directory)))
	178
	179	(defvar mh-variants nil
	180	"List describing known MH variants.
	181	Created by the function `mh-variants'")
	182
	183	(defun mh-variant-mh-info (dir)
	184	"Return info for MH variant in DIR assuming a temporary buffer is setup."
	185	;; MH does not have the -version option.
	186	;; Its version number is included in the output of `-help' as:
	187	;;
	188	;; version: MH 6.8.4 #2[UCI] (burrito) of Fri Jan 15 20:01:39 EST 1999
	189	;; options: [ATHENA] [BIND] [DUMB] [LIBLOCKFILE] [LOCALE] [MAILGROUP] [MHE]
	190	;; [MHRC] [MIME] [MORE='"/usr/bin/sensible-pager"'] [NLINK_HACK]
	191	;; [NORUSERPASS] [OVERHEAD] [POP] [POPSERVICE='"pop-3"'] [RENAME]
	192	;; [RFC1342] [RPATHS] [RPOP] [SENDMTS] [SMTP] [SOCKETS]
	193	;; [SPRINTFTYPE=int] [SVR4] [SYS5] [SYS5DIR] [TERMINFO]
	194	;; [TYPESIG=void] [UNISTD] [UTK] [VSPRINTF]
	195	(let ((mhparam (expand-file-name "mhparam" dir)))
	196	(when (and (file-exists-p mhparam) (file-executable-p mhparam))
	197	(erase-buffer)
	198	(call-process mhparam nil '(t nil) nil "-help")
	199	(goto-char (point-min))
	200	(when (search-forward-regexp "version: MH \\(\\S +\\)" nil t)
	201	(let ((version (format "MH %s" (match-string 1))))
	202	(erase-buffer)
	203	(call-process mhparam nil '(t nil) nil "libdir")
	204	(goto-char (point-min))
	205	(when (search-forward-regexp "^.*$" nil t)
	206	(let ((libdir (match-string 0)))
	207	`(,version
	208	(variant mh)
	209	(mh-lib-progs ,libdir)
	210	(mh-lib ,libdir)
	211	(mh-progs ,dir)
	212	(flists nil)))))))))
	213
	214	(defun mh-variant-mu-mh-info (dir)
	215	"Return info for GNU mailutils variant in DIR.
	216	This assumes that a temporary buffer is setup."
	217	;; 'mhparam -version' output:
	218	;; mhparam (GNU mailutils 0.3.2)
	219	(let ((mhparam (expand-file-name "mhparam" dir)))
	220	(when (and (file-exists-p mhparam) (file-executable-p mhparam))
	221	(erase-buffer)
	222	(call-process mhparam nil '(t nil) nil "-version")
	223	(goto-char (point-min))
	224	(when (search-forward-regexp "mhparam (\\(GNU [Mm]ailutils \\S +\\))"
	225	nil t)
	226	(let ((version (match-string 1)))
	227	(erase-buffer)
	228	(call-process mhparam nil '(t nil) nil "libdir" "etcdir")
	229	(goto-char (point-min))
	230	(when (search-forward-regexp "^libdir:\\s-\\(\\S-+\\)\\s-*$" nil t)
	231	(let ((libdir (match-string 1)))
	232	(goto-char (point-min))
	233	(when (search-forward-regexp
	234	"^etcdir:\\s-\\(\\S-+\\)\\s-*$" nil t)
	235	(let ((etcdir (match-string 1))
	236	(flists (file-exists-p (expand-file-name "flists" dir))))
	237	`(,version
	238	(variant mu-mh)
	239	(mh-lib-progs ,libdir)
	240	(mh-lib ,etcdir)
241	(mh-progs ,dir)
242	(flists ,flists)))))))))))
243
244	(defun mh-variant-nmh-info (dir)
245	"Return info for nmh variant in DIR assuming a temporary buffer is setup."
246	;; `mhparam -version' outputs:
247	;; mhparam -- nmh-1.1-RC1 [compiled on chaak at Fri Jun 20 11:03:28 PDT 2003]
248	(let ((mhparam (expand-file-name "mhparam" dir)))
249	(when (and (file-exists-p mhparam) (file-executable-p mhparam))
250	(erase-buffer)
251	(call-process mhparam nil '(t nil) nil "-version")
252	(goto-char (point-min))
253	(when (search-forward-regexp "mhparam -- nmh-\\(\\S +\\)" nil t)
254	(let ((version (format "nmh %s" (match-string 1))))
255	(erase-buffer)
256	(call-process mhparam nil '(t nil) nil "libdir" "etcdir")
257	(goto-char (point-min))
258	(when (search-forward-regexp "^libdir:\\s-\\(\\S-+\\)\\s-*$" nil t)
259	(let ((libdir (match-string 1)))
260	(goto-char (point-min))
261	(when (search-forward-regexp
262	"^etcdir:\\s-\\(\\S-+\\)\\s-*$" nil t)
263	(let ((etcdir (match-string 1))
264	(flists (file-exists-p (expand-file-name "flists" dir))))
265	`(,version
266	(variant nmh)
267	(mh-lib-progs ,libdir)
268	(mh-lib ,etcdir)
269	(mh-progs ,dir)
270	(flists ,flists)))))))))))
271
272	(defun mh-variant-info (dir)
273	"Return MH variant found in DIR, or nil if none present."
274	(save-excursion
275	(let ((tmp-buffer (get-buffer-create mh-temp-buffer)))
276	(set-buffer tmp-buffer)
277	(cond
278	((mh-variant-mh-info dir))
279	((mh-variant-nmh-info dir))
280	((mh-variant-mu-mh-info dir))))))
281
282	;;;###mh-autoload
283	(defun mh-variants ()
284	"Return a list of installed variants of MH on the system.
285	This function looks for MH in `mh-sys-path', `mh-path' and
286	`exec-path'. The format of the list of variants that is returned is described
287	by the variable `mh-variants'."
288	(if mh-variants
289	mh-variants
290	(let ((list-unique))
291	;; Make a unique list of directories, keeping the given order.
292	;; We don't want the same MH variant to be listed multiple times.
293	(loop for dir in (append mh-path mh-sys-path exec-path) do
294	(setq dir (file-chase-links (directory-file-name dir)))
295	(add-to-list 'list-unique dir))
296	(loop for dir in (nreverse list-unique) do
297	(when (and dir (file-directory-p dir) (file-readable-p dir))
298	(let ((variant (mh-variant-info dir)))
299	(if variant
300	(add-to-list 'mh-variants variant)))))
301	mh-variants)))
302
a05fcb7d BW	303	;;; XXX The two calls to message in this function should really be calls to
	304	;;; error. However, when this function is compiled via the top-level call in
	305	;;; mh-customize.el, it is actually called, and in a compile environment, the
	306	;;; errors are triggered which botches the compile. As a workaround, the calls
	307	;;; to error have been changed to calls to message, and code following was
	308	;;; inserted as an else clause. This is not robust, so if you can fix this,
	309	;;; please do!
	310	;;;###mh-autoload
	311	(defun mh-image-load-path ()
	312	"Ensure that the MH-E images are accessible by `find-image'.
	313	Images for MH-E are found in ../../etc/images relative to the files in
deceef67	314	`lisp/mh-e'. If `image-load-path' exists (since Emacs 22), then the images
a05fcb7d BW	315	directory is added to it if isn't already there. Otherwise, the images
	316	directory is added to the `load-path' if it isn't already there."
	317	(let (mh-load-path mh-image-load-path)
	318	;; First, find mh-e in the load-path.
	319	(let ((path load-path))
	320	(while path
	321	(let* ((directory (directory-file-name (car path))))
	322	(setq mh-load-path
	323	(if (and (equal (file-name-nondirectory directory) "mh-e")
	324	(file-exists-p directory))
	325	directory
	326	nil))
	327	(setq path (if mh-load-path nil (cdr path)))))
	328	(if (not mh-load-path)
	329	;; This message be error; there shouldn't be an else. Blame compiler.
	330	(message "Can not find mh-e in load-path (OK when compiling)")
	331	;; Create the image path associated with this mh-e directory.
	332	(setq mh-image-load-path (expand-file-name
	333	(concat (file-name-directory mh-load-path)
	334	"../etc/images")))))
	335	(if (or (not mh-image-load-path)
	336	(not (file-exists-p mh-image-load-path)))
	337	;; This message be error; there shouldn't be an else. Blame compiler.
	338	(message "Can not find image directory %s (OK when compiling)"
	339	mh-image-load-path)
	340	;; If image-load-path exists, and the image path isn't there add it.
	341	(if (boundp 'image-load-path)
	342	(if (not (member mh-image-load-path image-load-path))
	343	(push mh-image-load-path image-load-path))
	344	;; Otherwise, if the image path isn't in the load-path, add it there.
	345	(if (not (member mh-image-load-path load-path))
	346	(push mh-image-load-path load-path))))))
	347
863e5e39 BW	348	(provide 'mh-init)
	349
	350	;;; Local Variables:
	351	;;; indent-tabs-mode: nil
	352	;;; sentence-end-double-space: nil
	353	;;; End:
	354
b22103fe	355	;; arch-tag: e8372aeb-d803-42b1-9c95-3c93ad22f63c
863e5e39	356	;;; mh-init.el ends here