(mail-extract-address-components): Accept strings
[bpt/emacs.git] / lisp / emacs-lisp / lisp-mnt.el
CommitLineData
0fc37e7d
ER
1;;; lisp-mnt.el --- minor mode for Emacs Lisp maintainers
2
8f1204db 3;; Copyright (C) 1992, 1994 Free Software Foundation, Inc.
0fc37e7d
ER
4
5;; Author: Eric S. Raymond <esr@snark.thyrsus.com>
6;; Maintainer: Eric S. Raymond <esr@snark.thyrsus.com>
7;; Created: 14 Jul 1992
f9636fb2 8;; Version: $Id: lisp-mnt.el,v 1.13 1996/01/25 00:55:13 kwzh Exp rms $
0fc37e7d 9;; Keywords: docs
1894df21 10;; X-Bogus-Bureaucratic-Cruft: Gruad will get you if you don't watch out!
0fc37e7d
ER
11
12;; This file is part of GNU Emacs.
13
14;; GNU Emacs is free software; you can redistribute it and/or modify
15;; it under the terms of the GNU General Public License as published by
7c938215 16;; the Free Software Foundation; either version 2, or (at your option)
0fc37e7d
ER
17;; any later version.
18
19;; GNU Emacs is distributed in the hope that it will be useful,
20;; but WITHOUT ANY WARRANTY; without even the implied warranty of
21;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
22;; GNU General Public License for more details.
23
24;; You should have received a copy of the GNU General Public License
b578f267
EN
25;; along with GNU Emacs; see the file COPYING. If not, write to the
26;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
27;; Boston, MA 02111-1307, USA.
0fc37e7d
ER
28
29;;; Commentary:
30
31;; This minor mode adds some services to Emacs-Lisp editing mode.
32;;
33;; First, it knows about the header conventions for library packages.
34;; One entry point supports generating synopses from a library directory.
35;; Another can be used to check for missing headers in library files.
36;;
37;; Another entry point automatically addresses bug mail to a package's
38;; maintainer or author.
39
40;; This file can be loaded by your lisp-mode-hook. Have it (require 'lisp-mnt)
41
42;; This file is an example of the header conventions. Note the following
43;; features:
44;;
45;; * Header line --- makes it possible to extract a one-line summary of
46;; the package's uses automatically for use in library synopses, KWIC
47;; indexes and the like.
48;;
49;; Format is three semicolons, followed by the filename, followed by
50;; three dashes, followed by the summary. All fields space-separated.
51;;
52;; * Author line --- contains the name and net address of at least
53;; the principal author.
54;;
68756f1f 55;; If there are multiple authors, they should be listed on continuation
0fc37e7d
ER
56;; lines led by ;;<TAB>, like this:
57;;
58;; ;; Author: Ashwin Ram <Ram-Ashwin@cs.yale.edu>
59;; ;; Dave Sill <de5@ornl.gov>
60;; ;; David Lawrence <tale@pawl.rpi.edu>
61;; ;; Noah Friedman <friedman@ai.mit.edu>
62;; ;; Joe Wells <jbw@maverick.uswest.com>
63;; ;; Dave Brennan <brennan@hal.com>
64;; ;; Eric Raymond <esr@snark.thyrsus.com>
65;;
66;; This field may have some special values; notably "FSF", meaning
67;; "Free Software Foundation".
68;;
69;; * Maintainer line --- should be a single name/address as in the Author
70;; line, or an address only, or the string "FSF". If there is no maintainer
71;; line, the person(s) in the Author field are presumed to be it. The example
72;; in this file is mildly bogus because the maintainer line is redundant.
73;; The idea behind these two fields is to be able to write a lisp function
74;; that does "send mail to the author" without having to mine the name out by
75;; hand. Please be careful about surrounding the network address with <> if
76;; there's also a name in the field.
77;;
78;; * Created line --- optional, gives the original creation date of the
79;; file. For historical interest, basically.
80;;
81;; * Version line --- intended to give the reader a clue if they're looking
68756f1f
ER
82;; at a different version of the file than the one they're accustomed to. This
83;; may be an RCS or SCCS header.
0fc37e7d
ER
84;;
85;; * Adapted-By line --- this is for FSF's internal use. The person named
86;; in this field was the one responsible for installing and adapting the
87;; package for the distribution. (This file doesn't have one because the
88;; author *is* one of the maintainers.)
89;;
90;; * Keywords line --- used by the finder code (now under construction)
c0d79871 91;; for finding Emacs Lisp code related to a topic.
0fc37e7d 92;;
1894df21
NF
93;; * X-Bogus-Bureaucratic-Cruft line --- this is a joke and an example
94;; of a comment header. Headers starting with `X-' should never be used
95;; for any real purpose; this is the way to safely add random headers
96;; without invoking the wrath of any program.
0fc37e7d
ER
97;;
98;; * Commentary line --- enables lisp code to find the developer's and
99;; maintainers' explanations of the package internals.
100;;
101;; * Change log line --- optional, exists to terminate the commentary
102;; section and start a change-log part, if one exists.
103;;
c0d79871 104;; * Code line --- exists so Lisp can know where commentary and/or
0fc37e7d
ER
105;; change-log sections end.
106;;
107;; * Footer line --- marks end-of-file so it can be distinguished from
108;; an expanded formfeed or the results of truncation.
109
110;;; Change Log:
111
112;; Tue Jul 14 23:44:17 1992 ESR
113;; * Created.
114
115;;; Code:
116
117(require 'picture) ; provides move-to-column-force
68756f1f 118(require 'emacsbug)
0fc37e7d
ER
119
120;; These functions all parse the headers of the current buffer
121
64e07c7b 122(defun lm-section-mark (hd &optional after)
0fc37e7d
ER
123 ;; Return the buffer location of a given section start marker
124 (save-excursion
125 (let ((case-fold-search t))
126 (goto-char (point-min))
822b684f 127 (if (re-search-forward (concat "^;;;;* " hd ":[ \t]*$") nil t)
0fc37e7d
ER
128 (progn
129 (beginning-of-line)
64e07c7b 130 (if after (forward-line 1))
0fc37e7d
ER
131 (point))
132 nil))))
133
134(defun lm-code-mark ()
135 ;; Return the buffer location of the code start marker
136 (lm-section-mark "Code"))
137
138(defun lm-header (hd)
139 ;; Return the contents of a named header
140 (goto-char (point-min))
141 (let ((case-fold-search t))
142 (if (re-search-forward
143 (concat "^;; " hd ": \\(.*\\)") (lm-code-mark) t)
144 (buffer-substring (match-beginning 1) (match-end 1))
145 nil)))
146
147(defun lm-header-multiline (hd)
148 ;; Return the contents of a named header, with possible continuation lines.
149 ;; Note -- the returned value is a list of strings, one per line.
150 (save-excursion
151 (goto-char (point-min))
152 (let ((res (save-excursion (lm-header hd))))
153 (if res
154 (progn
155 (forward-line 1)
156 (setq res (list res))
157 (while (looking-at "^;;\t\\(.*\\)")
158 (setq res (cons (buffer-substring
159 (match-beginning 1)
160 (match-end 1))
161 res))
162 (forward-line 1))
163 ))
164 res)))
165
166;; These give us smart access to the header fields and commentary
167
168(defun lm-summary (&optional file)
169 ;; Return the buffer's or FILE's one-line summary.
170 (save-excursion
171 (if file
172 (find-file file))
173 (goto-char (point-min))
174 (prog1
175 (if (looking-at "^;;; [^ ]+ --- \\(.*\\)")
176 (buffer-substring (match-beginning 1) (match-end 1)))
177 (if file
178 (kill-buffer (current-buffer)))
179 )))
180
68756f1f
ER
181
182(defun lm-crack-address (x)
183 ;; Given a string containing a human and email address, parse it
184 ;; into a cons pair (name . address).
185 (cond ((string-match "\\(.+\\) [(<]\\(\\S-+@\\S-+\\)[>)]" x)
186 (cons (substring x (match-beginning 1) (match-end 1))
187 (substring x (match-beginning 2) (match-end 2))))
188 ((string-match "\\(\\S-+@\\S-+\\) [(<]\\(.*\\)[>)]" x)
189 (cons (substring x (match-beginning 2) (match-end 2))
190 (substring x (match-beginning 1) (match-end 1))))
191 ((string-match "\\S-+@\\S-+" x)
192 (cons nil x))
193 (t
194 (cons x nil))))
195
0fc37e7d 196(defun lm-authors (&optional file)
68756f1f
ER
197 ;; Return the buffer's or FILE's author list. Each element of the
198 ;; list is a cons; the car is a name-aming-humans, the cdr an email
199 ;; address.
0fc37e7d
ER
200 (save-excursion
201 (if file
202 (find-file file))
68756f1f
ER
203 (let ((authorlist (lm-header-multiline "author")))
204 (prog1
205 (mapcar 'lm-crack-address authorlist)
206 (if file
207 (kill-buffer (current-buffer)))
208 ))))
0fc37e7d
ER
209
210(defun lm-maintainer (&optional file)
211 ;; Get a package's bug-report & maintenance address. Parse it out of FILE,
212 ;; or the current buffer if FILE is nil.
68756f1f 213 ;; The return value is a (name . address) cons.
0fc37e7d
ER
214 (save-excursion
215 (if file
216 (find-file file))
217 (prog1
68756f1f
ER
218 (let ((maint (lm-header "maintainer")))
219 (if maint
220 (lm-crack-address maint)
221 (car (lm-authors))))
0fc37e7d
ER
222 (if file
223 (kill-buffer (current-buffer)))
224 )))
225
226(defun lm-creation-date (&optional file)
227 ;; Return a package's creation date, if any. Parse it out of FILE,
228 ;; or the current buffer if FILE is nil.
229 (save-excursion
230 (if file
231 (find-file file))
232 (prog1
233 (lm-header "created")
234 (if file
235 (kill-buffer (current-buffer)))
236 )))
237
238
239(defun lm-last-modified-date (&optional file)
240 ;; Return a package's last-modified date, if you can find one.
241 (save-excursion
242 (if file
243 (find-file file))
244 (prog1
68756f1f
ER
245 (if (progn
246 (goto-char (point-min))
247 (re-search-forward
248 "\\$Id: [^ ]+ [^ ]+ \\([^/]+\\)/\\([^/]+\\)/\\([^ ]+\\) "
249 (lm-code-mark) t))
250 (format "%s %s %s"
251 (buffer-substring (match-beginning 3) (match-end 3))
252 (nth (string-to-int
253 (buffer-substring (match-beginning 2) (match-end 2)))
254 '("" "Jan" "Feb" "Mar" "Apr" "May" "Jun"
255 "Jul" "Aug" "Sep" "Oct" "Nov" "Dec"))
256 (buffer-substring (match-beginning 1) (match-end 1))
257 ))
0fc37e7d
ER
258 (if file
259 (kill-buffer (current-buffer)))
68756f1f 260 )))
0fc37e7d
ER
261
262(defun lm-version (&optional file)
263 ;; Return the package's version field.
264 ;; If none, look for an RCS or SCCS header to crack it out of.
265 (save-excursion
266 (if file
267 (find-file file))
268 (prog1
269 (or
270 (lm-header "version")
271 (let ((header-max (lm-code-mark)))
272 (goto-char (point-min))
273 (cond
274 ;; Look for an RCS header
275 ((re-search-forward "\\$Id: [^ ]+ \\([^ ]+\\) " header-max t)
276 (buffer-substring (match-beginning 1) (match-end 1)))
277
278 ;; Look for an SCCS header
279 ((re-search-forward
280 (concat
281 (regexp-quote "@(#)")
282 (regexp-quote (file-name-nondirectory (buffer-file-name)))
283 "\t\\([012345679.]*\\)")
284 header-max t)
285 (buffer-substring (match-beginning 1) (match-end 1)))
286
287 (t nil))))
288 (if file
289 (kill-buffer (current-buffer)))
290 )))
291
292(defun lm-keywords (&optional file)
293 ;; Return the header containing the package's topic keywords.
294 ;; Parse them out of FILE, or the current buffer if FILE is nil.
295 (save-excursion
296 (if file
297 (find-file file))
298 (prog1
299 (let ((keywords (lm-header "keywords")))
300 (and keywords (downcase keywords)))
301 (if file
302 (kill-buffer (current-buffer)))
303 )))
304
305(defun lm-adapted-by (&optional file)
306 ;; Return the name or code of the person who cleaned up this package
307 ;; for distribution. Parse it out of FILE, or the current buffer if
308 ;; FILE is nil.
309 (save-excursion
310 (if file
311 (find-file file))
312 (prog1
313 (lm-header "adapted-by")
314 (if file
315 (kill-buffer (current-buffer)))
316 )))
317
64e07c7b 318(defun lm-commentary (&optional file)
4c7f5b00 319 ;; Return the commentary region of a file, as a string.
0fc37e7d
ER
320 (save-excursion
321 (if file
322 (find-file file))
323 (prog1
64e07c7b 324 (let ((commentary (lm-section-mark "Commentary" t))
0fc37e7d
ER
325 (change-log (lm-section-mark "Change Log"))
326 (code (lm-section-mark "Code")))
64e07c7b 327 (and commentary
0fc37e7d 328 (if change-log
64e07c7b
ER
329 (buffer-substring commentary change-log)
330 (buffer-substring commentary code)))
0fc37e7d
ER
331 )
332 (if file
333 (kill-buffer (current-buffer)))
334 )))
335
336;;; Verification and synopses
337
f9636fb2 338(defun lm-insert-at-column (col &rest pieces)
0fc37e7d
ER
339 (if (> (current-column) col) (insert "\n"))
340 (move-to-column-force col)
341 (apply 'insert pieces))
342
343(defconst lm-comment-column 16)
344
345(defun lm-verify (&optional file showok)
346 "Check that the current buffer (or FILE if given) is in proper format.
347If FILE is a directory, recurse on its files and generate a report into
348a temporary buffer."
349 (if (and file (file-directory-p file))
350 (progn
351 (switch-to-buffer (get-buffer-create "*lm-verify*"))
352 (erase-buffer)
353 (mapcar
354 '(lambda (f)
355 (if (string-match ".*\\.el$" f)
356 (let ((status (lm-verify f)))
357 (if status
358 (progn
359 (insert f ":")
f9636fb2 360 (lm-insert-at-column lm-comment-column status "\n"))
0fc37e7d
ER
361 (and showok
362 (progn
363 (insert f ":")
f9636fb2 364 (lm-insert-at-column lm-comment-column "OK\n")))))))
0fc37e7d
ER
365 (directory-files file))
366 )
367 (save-excursion
368 (if file
369 (find-file file))
370 (prog1
371 (cond
372 ((not (lm-summary))
373 "Can't find a package summary")
374 ((not (lm-code-mark))
375 "Can't find a code section marker")
376 ((progn
377 (goto-char (point-max))
378 (forward-line -1)
379 (looking-at (concat ";;; " file "ends here")))
380 "Can't find a footer line")
381 )
382 (if file
383 (kill-buffer (current-buffer)))
384 ))))
385
386(defun lm-synopsis (&optional file showall)
387 "Generate a synopsis listing for the buffer or the given FILE if given.
388If FILE is a directory, recurse on its files and generate a report into
389a temporary buffer. If SHOWALL is on, also generate a line for files
390which do not include a recognizable synopsis."
f9636fb2 391 (interactive "fSynopsis for (file or dir): ")
0fc37e7d
ER
392 (if (and file (file-directory-p file))
393 (progn
394 (switch-to-buffer (get-buffer-create "*lm-verify*"))
395 (erase-buffer)
396 (mapcar
397 '(lambda (f)
398 (if (string-match ".*\\.el$" f)
399 (let ((syn (lm-synopsis f)))
400 (if syn
401 (progn
402 (insert f ":")
f9636fb2 403 (lm-insert-at-column lm-comment-column syn "\n"))
0fc37e7d
ER
404 (and showall
405 (progn
406 (insert f ":")
f9636fb2 407 (lm-insert-at-column lm-comment-column "NA\n")))))))
0fc37e7d
ER
408 (directory-files file))
409 )
410 (save-excursion
411 (if file
412 (find-file file))
413 (prog1
414 (lm-summary)
415 (if file
416 (kill-buffer (current-buffer)))
417 ))))
418
419(defun lm-report-bug (topic)
420 "Report a bug in the package currently being visited to its maintainer.
421Prompts for bug subject. Leaves you in a mail buffer."
68756f1f 422 (interactive "sBug Subject: ")
0fc37e7d
ER
423 (let ((package (buffer-name))
424 (addr (lm-maintainer))
425 (version (lm-version)))
3082623d
RS
426 (mail nil
427 (if addr
428 (concat (car addr) " <" (cdr addr) ">")
429 bug-gnu-emacs)
430 topic)
0fc37e7d
ER
431 (goto-char (point-max))
432 (insert "\nIn "
433 package
ef92f83b 434 (if version (concat " version " version) "")
0fc37e7d 435 "\n\n")
40ba5f3f 436 (message "%s"
0fc37e7d
ER
437 (substitute-command-keys "Type \\[mail-send] to send bug report."))))
438
439(provide 'lisp-mnt)
440
441;;; lisp-mnt.el ends here