aboutsummaryrefslogtreecommitdiffstats
path: root/lisp/mh-e/mh-init.el
blob: a975b882128d40f464f61d1fc3575f3771b26fb8 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
;;; mh-init.el --- MH-E initialization.

;; Copyright (C) 2003, 2004 Free Software Foundation, Inc.

;; Author: Peter S. Galbraith <[email protected]>
;; Maintainer: Bill Wohler <[email protected]>
;; 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, '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
  :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:

;; arch-tag: e8372aeb-d803-42b1-9c95-3c93ad22f63c
;;; mh-init.el ends here