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