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