code.delx.au - gnu-emacs/blob - lisp/mh-e/mh-init.el

   1 ;;; mh-init.el --- MH-E initialization.
   2
   3 ;; Copyright (C) 2003, 2004 Free Software Foundation, Inc.
   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
  24 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  25 ;; Boston, MA 02111-1307, USA.
  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
  44 ;;; Set for local environment:
  45 ;;; mh-progs and mh-lib used to be set in paths.el, which tried to
  46 ;;; figure out at build time which of several possible directories MH
  47 ;;; was installed into.  But if you installed MH after building Emacs,
  48 ;;; this would almost certainly be wrong, so now we do it at run time.
  49
  50 (defvar mh-progs nil
  51   "Directory containing MH commands, such as inc, repl, and rmm.")
  52
  53 (defvar mh-lib nil
  54   "Directory containing the MH library.
  55 This directory contains, among other things, the components file.")
  56
  57 (defvar mh-lib-progs nil
  58   "Directory containing MH helper programs.
  59 This directory contains, among other things, the mhl program.")
  60
  61 (defvar mh-flists-present-flag nil
  62   "Non-nil means that we have `flists'.")
  63
  64 ;;;###autoload
  65 (put 'mh-progs 'risky-local-variable t)
  66 ;;;###autoload
  67 (put 'mh-lib 'risky-local-variable t)
  68 ;;;###autoload
  69 (put 'mh-lib-progs 'risky-local-variable t)
  70
  71 (defvar mh-variant-in-use nil
  72   "The MH variant currently in use; a string with variant and version number.
  73 This differs from `mh-variant' when the latter is set to `autodetect'.")
  74
  75 ;;;###mh-autoload
  76 (defun mh-variant-set (variant)
  77   "Set the MH variant to VARIANT.
  78 Sets `mh-progs', `mh-lib', `mh-lib-progs' and `mh-flists-present-flag'.
  79 If the VARIANT is `autodetect', then first try nmh, then MH and finally
  80 GNU mailutils."
  81   (interactive
  82    (list (completing-read
  83           "MH Variant: "
  84           (mapcar (lambda (x) (list (car x))) (mh-variants))
  85           nil t)))
  86   (let ((valid-list (mapcar (lambda (x) (car x)) (mh-variants))))
  87     (cond
  88      ((eq variant 'none))
  89      ((eq variant 'autodetect)
  90       (cond
  91        ((mh-variant-set-variant 'nmh)
  92         (message "%s installed as MH variant" mh-variant-in-use))
  93        ((mh-variant-set-variant 'mh)
  94         (message "%s installed as MH variant" mh-variant-in-use))
  95        ((mh-variant-set-variant 'mu-mh)
  96         (message "%s installed as MH variant" mh-variant-in-use))
  97        (t
  98         (message "No MH variant found on the system!"))))
  99      ((member variant valid-list)
 100       (when (not (mh-variant-set-variant variant))
 101         (message "Warning: %s variant not found.  Autodetecting..." variant)
 102         (mh-variant-set 'autodetect)))
 103      (t
 104       (message "Unknown variant.  Use %s"
 105                (mapconcat '(lambda (x) (format "%s" (car x)))
 106                           mh-variants " or "))))))
 107
 108 (defun mh-variant-set-variant (variant)
 109   "Setup the system variables for the MH variant named VARIANT.
 110 If VARIANT is a string, use that key in the variable `mh-variants'.
 111 If VARIANT is a symbol, select the first entry that matches that variant."
 112   (cond
 113    ((stringp variant)                   ;e.g. "nmh 1.1-RC1"
 114     (when (assoc variant mh-variants)
 115       (let* ((alist (cdr (assoc variant mh-variants)))
 116              (lib-progs (cadr (assoc 'mh-lib-progs alist)))
 117              (lib       (cadr (assoc 'mh-lib       alist)))
 118              (progs     (cadr (assoc 'mh-progs     alist)))
 119              (flists    (cadr (assoc 'flists       alist))))
 120         ;;(set-default mh-variant variant)
 121         (setq mh-x-mailer-string     nil
 122               mh-flists-present-flag flists
 123               mh-lib-progs           lib-progs
 124               mh-lib                 lib
 125               mh-progs               progs
 126               mh-variant-in-use      variant))))
 127    ((symbolp variant)                   ;e.g. 'nmh (pick the first match)
 128     (loop for variant-list in mh-variants
 129           when (eq variant (cadr (assoc 'variant (cdr variant-list))))
 130           return (let* ((version   (car variant-list))
 131                         (alist (cdr variant-list))
 132                         (lib-progs (cadr (assoc 'mh-lib-progs alist)))
 133                         (lib       (cadr (assoc 'mh-lib       alist)))
 134                         (progs     (cadr (assoc 'mh-progs     alist)))
 135                         (flists    (cadr (assoc 'flists       alist))))
 136                    ;;(set-default mh-variant flavor)
 137                    (setq mh-x-mailer-string     nil
 138                          mh-flists-present-flag flists
 139                          mh-lib-progs           lib-progs
 140                          mh-lib                 lib
 141                          mh-progs               progs
 142                          mh-variant-in-use      version)
 143                    t)))))
 144
 145 ;;;###mh-autoload
 146 (defun mh-variant-p (&rest variants)
 147   "Return t if variant is any of VARIANTS.
 148 Currently known variants are 'MH, 'nmh, and 'mu-mh."
 149   (let ((variant-in-use
 150          (cadr (assoc 'variant (assoc mh-variant-in-use mh-variants)))))
 151     (not (null (member variant-in-use variants)))))
 152
 153 (defvar mh-sys-path
 154   '("/usr/local/nmh/bin"                ; nmh default
 155     "/usr/local/bin/mh/"
 156     "/usr/local/mh/"
 157     "/usr/bin/mh/"                      ; Ultrix 4.2, Linux
 158     "/usr/new/mh/"                      ; Ultrix < 4.2
 159     "/usr/contrib/mh/bin/"              ; BSDI
 160     "/usr/pkg/bin/"                     ; NetBSD
 161     "/usr/local/bin/"
 162     "/usr/local/bin/mu-mh/"             ; GNU mailutils - default
 163     "/usr/bin/mu-mh/")                  ; GNU mailutils - packaged
 164   "List of directories to search for variants of the MH variant.
 165 The list `exec-path' is searched in addition to this list.
 166 There's no need for users to modify this list.  Instead add extra
 167 directories to the customizable variable `mh-path'.")
 168
 169 (defcustom mh-path nil
 170   "*List of directories to search for variants of the MH variant.
 171 The directories will be searched for `mhparam' in addition to directories
 172 listed in `mh-sys-path' and `exec-path'."
 173   :group 'mh
 174   :type '(repeat (directory)))
 175
 176 (defvar mh-variants nil
 177   "List describing known MH variants.
 178 Created by the function `mh-variants'")
 179
 180 (defun mh-variant-mh-info (dir)
 181   "Return info for MH variant in DIR assuming a temporary buffer is setup."
 182   ;; MH does not have the -version option.
 183   ;; Its version number is included in the output of `-help' as:
 184   ;;
 185   ;; version: MH 6.8.4 #2[UCI] (burrito) of Fri Jan 15 20:01:39 EST 1999
 186   ;; options: [ATHENA] [BIND] [DUMB] [LIBLOCKFILE] [LOCALE] [MAILGROUP] [MHE]
 187   ;;          [MHRC] [MIME] [MORE='"/usr/bin/sensible-pager"'] [NLINK_HACK]
 188   ;;          [NORUSERPASS] [OVERHEAD] [POP] [POPSERVICE='"pop-3"'] [RENAME]
 189   ;;          [RFC1342] [RPATHS] [RPOP] [SENDMTS] [SMTP] [SOCKETS]
 190   ;;          [SPRINTFTYPE=int] [SVR4] [SYS5] [SYS5DIR] [TERMINFO]
 191   ;;          [TYPESIG=void] [UNISTD] [UTK] [VSPRINTF]
 192   (let ((mhparam (expand-file-name "mhparam" dir)))
 193     (when (and (file-exists-p mhparam) (file-executable-p mhparam))
 194       (erase-buffer)
 195       (call-process mhparam nil '(t nil) nil "-help")
 196       (goto-char (point-min))
 197       (when (search-forward-regexp "version: MH \\(\\S +\\)" nil t)
 198         (let ((version (format "MH %s" (match-string 1))))
 199           (erase-buffer)
 200           (call-process mhparam nil '(t nil) nil "libdir")
 201           (goto-char (point-min))
 202           (when (search-forward-regexp "^.*$" nil t)
 203             (let ((libdir (match-string 0)))
 204               `(,version
 205                 (variant        mh)
 206                 (mh-lib-progs   ,libdir)
 207                 (mh-lib         ,libdir)
 208                 (mh-progs       ,dir)
 209                 (flists         nil)))))))))
 210
 211 (defun mh-variant-mu-mh-info (dir)
 212   "Return info for GNU mailutils variant in DIR.
 213 This assumes that a temporary buffer is setup."
 214   ;; 'mhparam -version' output:
 215   ;; mhparam (GNU mailutils 0.3.2)
 216   (let ((mhparam (expand-file-name "mhparam" dir)))
 217     (when (and (file-exists-p mhparam) (file-executable-p mhparam))
 218       (erase-buffer)
 219       (call-process mhparam nil '(t nil) nil "-version")
 220       (goto-char (point-min))
 221       (when (search-forward-regexp "mhparam (\\(GNU [Mm]ailutils \\S +\\))"
 222                                    nil t)
 223         (let ((version (match-string 1)))
 224           (erase-buffer)
 225           (call-process mhparam nil '(t nil) nil "libdir" "etcdir")
 226           (goto-char (point-min))
 227           (when (search-forward-regexp "^libdir:\\s-\\(\\S-+\\)\\s-*$" nil t)
 228             (let ((libdir (match-string 1)))
 229               (goto-char (point-min))
 230               (when (search-forward-regexp
 231                      "^etcdir:\\s-\\(\\S-+\\)\\s-*$" nil t)
 232                 (let ((etcdir (match-string 1))
 233                       (flists (file-exists-p (expand-file-name "flists" dir))))
 234                   `(,version
 235                     (variant        mu-mh)
 236                     (mh-lib-progs   ,libdir)
 237                     (mh-lib         ,etcdir)
 238                     (mh-progs       ,dir)
 239                     (flists         ,flists)))))))))))
 240
 241 (defun mh-variant-nmh-info (dir)
 242   "Return info for nmh variant in DIR assuming a temporary buffer is setup."
 243   ;; `mhparam -version' outputs:
 244   ;; mhparam -- nmh-1.1-RC1 [compiled on chaak at Fri Jun 20 11:03:28 PDT 2003]
 245   (let ((mhparam (expand-file-name "mhparam" dir)))
 246     (when (and (file-exists-p mhparam) (file-executable-p mhparam))
 247       (erase-buffer)
 248       (call-process mhparam nil '(t nil) nil "-version")
 249       (goto-char (point-min))
 250       (when (search-forward-regexp "mhparam -- nmh-\\(\\S +\\)" nil t)
 251         (let ((version (format "nmh %s" (match-string 1))))
 252           (erase-buffer)
 253           (call-process mhparam nil '(t nil) nil "libdir" "etcdir")
 254           (goto-char (point-min))
 255           (when (search-forward-regexp "^libdir:\\s-\\(\\S-+\\)\\s-*$" nil t)
 256             (let ((libdir (match-string 1)))
 257               (goto-char (point-min))
 258               (when (search-forward-regexp
 259                      "^etcdir:\\s-\\(\\S-+\\)\\s-*$" nil t)
 260                 (let ((etcdir (match-string 1))
 261                       (flists (file-exists-p (expand-file-name "flists" dir))))
 262                   `(,version
 263                     (variant        nmh)
 264                     (mh-lib-progs   ,libdir)
 265                     (mh-lib         ,etcdir)
 266                     (mh-progs       ,dir)
 267                     (flists         ,flists)))))))))))
 268
 269 (defun mh-variant-info (dir)
 270   "Return MH variant found in DIR, or nil if none present."
 271   (save-excursion
 272     (let ((tmp-buffer (get-buffer-create mh-temp-buffer)))
 273       (set-buffer tmp-buffer)
 274       (cond
 275        ((mh-variant-mh-info dir))
 276        ((mh-variant-nmh-info dir))
 277        ((mh-variant-mu-mh-info dir))))))
 278
 279 ;;;###mh-autoload
 280 (defun mh-variants ()
 281   "Return a list of installed variants of MH on the system.
 282 This function looks for MH in `mh-sys-path', `mh-path' and
 283 `exec-path'. The format of the list of variants that is returned is described
 284 by the variable `mh-variants'."
 285   (if mh-variants
 286       mh-variants
 287     (let ((list-unique))
 288       ;; Make a unique list of directories, keeping the given order.
 289       ;; We don't want the same MH variant to be listed multiple times.
 290       (loop for dir in (append mh-path mh-sys-path exec-path) do
 291             (setq dir (file-chase-links (directory-file-name dir)))
 292             (add-to-list 'list-unique dir))
 293       (loop for dir in (nreverse list-unique) do
 294             (when (and dir (file-directory-p dir) (file-readable-p dir))
 295               (let ((variant (mh-variant-info dir)))
 296                 (if variant
 297                     (add-to-list 'mh-variants variant)))))
 298       mh-variants)))
 299
 300 (provide 'mh-init)
 301
 302 ;;; Local Variables:
 303 ;;; indent-tabs-mode: nil
 304 ;;; sentence-end-double-space: nil
 305 ;;; End:
 306
 307 ;; arch-tag: e8372aeb-d803-42b1-9c95-3c93ad22f63c
 308 ;;; mh-init.el ends here