lisp-mnt.el 16.3 KB
Newer Older
Eric S. Raymond's avatar
Eric S. Raymond committed
1 2
;;; lisp-mnt.el --- minor mode for Emacs Lisp maintainers

Dave Love's avatar
Dave Love committed
3
;; Copyright (C) 1992, 1994, 1997 Free Software Foundation, Inc.
Eric S. Raymond's avatar
Eric S. Raymond committed
4 5 6 7 8

;; Author: Eric S. Raymond <esr@snark.thyrsus.com>
;; Maintainer: Eric S. Raymond <esr@snark.thyrsus.com>
;; Created: 14 Jul 1992
;; Keywords: docs
9
;; X-Bogus-Bureaucratic-Cruft: Gruad will get you if you don't watch out!
Eric S. Raymond's avatar
Eric S. Raymond committed
10 11 12 13 14

;; 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
Karl Heuer's avatar
Karl Heuer committed
15
;; the Free Software Foundation; either version 2, or (at your option)
Eric S. Raymond's avatar
Eric S. Raymond committed
16 17 18 19 20 21 22 23
;; 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
24
;; along with GNU Emacs; see the file COPYING.  If not, write to
Erik Naggum's avatar
Erik Naggum committed
25 26
;; the Free Software Foundation,  Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.
Eric S. Raymond's avatar
Eric S. Raymond committed
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

;;; Commentary:

;; This minor mode adds some services to Emacs-Lisp editing mode.
;;
;; First, it knows about the header conventions for library packages.
;; One entry point supports generating synopses from a library directory.
;; Another can be used to check for missing headers in library files.
;; 
;; Another entry point automatically addresses bug mail to a package's
;; maintainer or author.

;; This file can be loaded by your lisp-mode-hook.  Have it (require 'lisp-mnt)

;; This file is an example of the header conventions.  Note the following
;; features:
;; 
;;    * Header line --- makes it possible to extract a one-line summary of
;; the package's uses automatically for use in library synopses, KWIC
;; indexes and the like.
;; 
;;    Format is three semicolons, followed by the filename, followed by
;; three dashes, followed by the summary.  All fields space-separated.
;; 
;;    * Author line --- contains the name and net address of at least
;; the principal author.
;; 
54
;;    If there are multiple authors, they should be listed on continuation
Eric S. Raymond's avatar
Eric S. Raymond committed
55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71
;; lines led by ;;<TAB>, like this:
;; 
;; ;; Author: Ashwin Ram <Ram-Ashwin@cs.yale.edu>
;; ;;	Dave Sill <de5@ornl.gov>
;; ;;	David Lawrence <tale@pawl.rpi.edu>
;; ;;	Noah Friedman <friedman@ai.mit.edu>
;; ;;	Joe Wells <jbw@maverick.uswest.com>
;; ;;	Dave Brennan <brennan@hal.com>
;; ;;	Eric Raymond <esr@snark.thyrsus.com>
;; 
;; This field may have some special values; notably "FSF", meaning
;; "Free Software Foundation".
;; 
;;    * Maintainer line --- should be a single name/address as in the Author
;; line, or an address only, or the string "FSF".  If there is no maintainer
;; line, the person(s) in the Author field are presumed to be it.  The example
;; in this file is mildly bogus because the maintainer line is redundant.
72
;;    The idea behind these two fields is to be able to write a Lisp function
Eric S. Raymond's avatar
Eric S. Raymond committed
73 74 75 76 77 78 79 80
;; that does "send mail to the author" without having to mine the name out by
;; hand. Please be careful about surrounding the network address with <> if
;; there's also a name in the field.
;; 
;;    * Created line --- optional, gives the original creation date of the
;; file.  For historical interest, basically.
;; 
;;    * Version line --- intended to give the reader a clue if they're looking
81 82
;; at a different version of the file than the one they're accustomed to.  This
;; may be an RCS or SCCS header.
Eric S. Raymond's avatar
Eric S. Raymond committed
83 84 85 86 87 88 89
;; 
;;    * Adapted-By line --- this is for FSF's internal use.  The person named
;; in this field was the one responsible for installing and adapting the
;; package for the distribution.  (This file doesn't have one because the
;; author *is* one of the maintainers.)
;; 
;;    * Keywords line --- used by the finder code (now under construction)
Richard M. Stallman's avatar
Richard M. Stallman committed
90
;; for finding Emacs Lisp code related to a topic.
Eric S. Raymond's avatar
Eric S. Raymond committed
91
;;
92 93 94 95
;;    * X-Bogus-Bureaucratic-Cruft line --- this is a joke and an example
;; of a comment header.  Headers starting with `X-' should never be used
;; for any real purpose; this is the way to safely add random headers
;; without invoking the wrath of any program.
Eric S. Raymond's avatar
Eric S. Raymond committed
96
;;
97
;;    * Commentary line --- enables Lisp code to find the developer's and
Eric S. Raymond's avatar
Eric S. Raymond committed
98 99 100 101 102
;; maintainers' explanations of the package internals.
;; 
;;    * Change log line --- optional, exists to terminate the commentary
;; section and start a change-log part, if one exists.
;; 
Richard M. Stallman's avatar
Richard M. Stallman committed
103
;;    * Code line --- exists so Lisp can know where commentary and/or
Eric S. Raymond's avatar
Eric S. Raymond committed
104 105 106 107 108 109 110 111 112 113 114 115
;; change-log sections end.
;; 
;;    * Footer line --- marks end-of-file so it can be distinguished from
;; an expanded formfeed or the results of truncation.

;;; Change Log:

;; Tue Jul 14 23:44:17 1992	ESR
;;	* Created.

;;; Code:

116
(require 'emacsbug)
Eric S. Raymond's avatar
Eric S. Raymond committed
117

118 119
;;; Variables:

Stephen Eglen's avatar
Stephen Eglen committed
120 121 122 123 124 125
(defgroup lisp-mnt nil
  "Minor mode for Emacs Lisp maintainers."
  :prefix "lm-"
  :group 'maint)

(defcustom lm-header-prefix "^;;*[ \t]+\\(@\(#\)\\)?[ \t]*\\([\$]\\)?"
126
  "Prefix that is ignored before the tag.
127 128
For example, you can write the 1st line synopsis string and headers like this
in your Lisp package:
129 130 131 132 133 134

   ;; @(#) package.el -- pacakge description
   ;;
   ;; @(#) $Maintainer:   Person Foo Bar $

The @(#) construct is used by unix what(1) and
Stephen Eglen's avatar
Stephen Eglen committed
135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152
then $identifier: doc string $ is used by GNU ident(1)"
  :type 'regexp
  :group 'lisp-mnt)

(defcustom lm-comment-column 16
  "Column used for placing formatted output."
  :type 'integer
  :group 'lisp-mnt)

(defcustom lm-commentary-header "Commentary\\|Documentation"
  "Regexp which matches start of documentation section."
  :type 'regexp
  :group 'lisp-mnt)

(defcustom lm-history-header "Change Log\\|History"
  "Regexp which matches the start of code log section."
  :type 'regexp
  :group 'lisp-mnt)
153 154 155

;;; Functions:

Eric S. Raymond's avatar
Eric S. Raymond committed
156 157
;; These functions all parse the headers of the current buffer

158
(defsubst lm-get-header-re (header &optional mode)
Dave Love's avatar
Dave Love committed
159
  "Return regexp for matching HEADER.
160 161 162 163 164 165
If called with optional MODE and with value `section',
return section regexp instead."
  (cond ((eq mode 'section)
	 (concat "^;;;;* " header ":[ \t]*$"))
	(t
	 (concat lm-header-prefix header ":[ \t]*"))))
166 167

(defsubst lm-get-package-name ()
Dave Love's avatar
Dave Love committed
168
  "Return package name by looking at the first line."
169 170 171 172 173 174
  (save-excursion
    (goto-char (point-min))
    (if (and (looking-at (concat lm-header-prefix))
	     (progn (goto-char (match-end 0))
		    (looking-at "\\([^\t ]+\\)")
		    (match-end 1)))
Dave Love's avatar
Dave Love committed
175
	(buffer-substring-no-properties (match-beginning 1) (match-end 1))
176 177 178 179
      )))

(defun lm-section-mark (header &optional after)
  "Return the buffer location of a given section start marker.
180 181
The HEADER is the section mark string to search for.
If AFTER is non-nil, return the location of the next line."
Eric S. Raymond's avatar
Eric S. Raymond committed
182 183 184
  (save-excursion
    (let ((case-fold-search t))
      (goto-char (point-min))
185
      (if (re-search-forward (lm-get-header-re header 'section) nil t)
Eric S. Raymond's avatar
Eric S. Raymond committed
186 187
	  (progn
	    (beginning-of-line)
188
	    (if after (forward-line 1))
Eric S. Raymond's avatar
Eric S. Raymond committed
189 190 191
	    (point))
	nil))))

192
(defsubst lm-code-mark ()
193
  "Return the buffer location of the `Code' start marker."
Eric S. Raymond's avatar
Eric S. Raymond committed
194 195
  (lm-section-mark "Code"))

196
(defsubst lm-commentary-mark ()
197
  "Return the buffer location of the `Commentary' start marker."
198 199 200
  (lm-section-mark lm-commentary-header))

(defsubst lm-history-mark ()
201
  "Return the buffer location of the `History' start marker."
202 203 204
  (lm-section-mark lm-history-header))

(defun lm-header (header)
205 206 207 208 209 210 211
  "Return the contents of the header named HEADER."
  (goto-char (point-min))
  (let ((case-fold-search t))
    (if (and (re-search-forward (lm-get-header-re header) (lm-code-mark) t)
	     ;;   RCS ident likes format "$identifier: data$"
	     (looking-at "\\([^$\n]+\\)")
	     (match-end 1))
Dave Love's avatar
Dave Love committed
212
	(buffer-substring-no-properties (match-beginning 1) (match-end 1))
213
      nil)))
Eric S. Raymond's avatar
Eric S. Raymond committed
214

215
(defun lm-header-multiline (header)
216
  "Return the contents of the header named HEADER, with continuation lines.
217
The returned value is a list of strings, one per line."
Eric S. Raymond's avatar
Eric S. Raymond committed
218 219
  (save-excursion
    (goto-char (point-min))
220
    (let ((res (lm-header header)))
221
      (when res
222 223 224 225 226 227 228 229
	(setq res (list res))
	(forward-line 1)

	(while (and (looking-at (concat lm-header-prefix "[\t ]+"))
		    (progn
		      (goto-char (match-end 0))
		      (looking-at "\\(.*\\)"))
		    (match-end 1))
Dave Love's avatar
Dave Love committed
230
	  (setq res (cons (buffer-substring-no-properties
231 232 233 234
			   (match-beginning 1)
			   (match-end 1))
			  res))
	  (forward-line 1))
235
	)
236 237
      res
      )))
Eric S. Raymond's avatar
Eric S. Raymond committed
238 239 240

;; These give us smart access to the header fields and commentary

241 242 243 244 245 246 247 248 249 250 251
(defmacro lm-with-file (file &rest body)
  (let ((filesym (make-symbol "file")))
    `(save-excursion
       (let ((,filesym ,file))
	 (if ,filesym (set-buffer (find-file-noselect ,filesym)))
	 (prog1 (progn ,@body)
	   (if (and ,filesym (not (get-buffer-window (current-buffer) t)))
	       (kill-buffer (current-buffer))))))))
(put 'lm-with-file 'lisp-indent-function 1)
(put 'lm-with-file 'edebug-form-spec t)

Eric S. Raymond's avatar
Eric S. Raymond committed
252
(defun lm-summary (&optional file)
253
  "Return the one-line summary of file FILE, or current buffer if FILE is nil."
254
  (lm-with-file file
Eric S. Raymond's avatar
Eric S. Raymond committed
255
    (goto-char (point-min))
256 257 258 259 260 261 262 263 264 265
    (if (and
	 (looking-at lm-header-prefix)
	 (progn (goto-char (match-end 0))
		(looking-at "[^ ]+[ \t]+--+[ \t]+\\(.*\\)")))
	(let ((summary (buffer-substring-no-properties (match-beginning 1)
						       (match-end 1))))
	  ;; Strip off -*- specifications.
	  (if (string-match "[ \t]*-\\*-.*-\\*-" summary)
	      (substring summary 0 (match-beginning 0))
	    summary)))))
Eric S. Raymond's avatar
Eric S. Raymond committed
266

267
(defun lm-crack-address (x)
Dave Love's avatar
Dave Love committed
268
  "Split up an email address X into full name and real email address.
269
The value is a cons of the form (FULLNAME . ADDRESS)."
270 271 272 273 274 275 276 277 278 279 280
  (cond ((string-match "\\(.+\\) [(<]\\(\\S-+@\\S-+\\)[>)]" x)
	 (cons (substring x (match-beginning 1) (match-end 1))
	       (substring x (match-beginning 2) (match-end 2))))
	((string-match "\\(\\S-+@\\S-+\\) [(<]\\(.*\\)[>)]" x)
	 (cons (substring x (match-beginning 2) (match-end 2))
	       (substring x (match-beginning 1) (match-end 1))))
	((string-match "\\S-+@\\S-+" x)
	 (cons nil x))
	(t
	 (cons x nil))))

Eric S. Raymond's avatar
Eric S. Raymond committed
281
(defun lm-authors (&optional file)
282 283 284
  "Return the author list of file FILE, or current buffer if FILE is nil.
Each element of the list is a cons; the car is the full name,
the cdr is an email address."
285
  (lm-with-file file
286
    (let ((authorlist (lm-header-multiline "author")))
287
      (mapcar 'lm-crack-address authorlist))))
Eric S. Raymond's avatar
Eric S. Raymond committed
288 289

(defun lm-maintainer (&optional file)
290 291
  "Return the maintainer of file FILE, or current buffer if FILE is nil.
The return value has the form (NAME . ADDRESS)."
292 293 294 295 296
  (lm-with-file file
    (let ((maint (lm-header "maintainer")))
      (if maint
	  (lm-crack-address maint)
	(car (lm-authors))))))
Eric S. Raymond's avatar
Eric S. Raymond committed
297 298

(defun lm-creation-date (&optional file)
299
  "Return the created date given in file FILE, or current buffer if FILE is nil."
300 301
  (lm-with-file file
    (lm-header "created")))
Eric S. Raymond's avatar
Eric S. Raymond committed
302 303 304


(defun lm-last-modified-date (&optional file)
305
  "Return the modify-date given in file FILE, or current buffer if FILE is nil."
306 307 308 309 310 311 312 313 314 315 316 317
  (lm-with-file file
    (goto-char (point-min))
    (when (re-search-forward
	   "\\$[I]d: [^ ]+ [^ ]+ \\([^/]+\\)/\\([^/]+\\)/\\([^ ]+\\) "
	   (lm-code-mark) t)
      (format "%s %s %s"
	      (buffer-substring (match-beginning 3) (match-end 3))
	      (nth (string-to-int 
		    (buffer-substring (match-beginning 2) (match-end 2)))
		   '("" "Jan" "Feb" "Mar" "Apr" "May" "Jun"
		     "Jul" "Aug" "Sep" "Oct" "Nov" "Dec"))
	      (buffer-substring (match-beginning 1) (match-end 1))))))
Eric S. Raymond's avatar
Eric S. Raymond committed
318 319

(defun lm-version (&optional file)
320 321
  "Return the version listed in file FILE, or current buffer if FILE is nil.
This can befound in an RCS or SCCS header to crack it out of."
322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341
  (lm-with-file file
    (or
     (lm-header "version")
     (let ((header-max (lm-code-mark)))
       (goto-char (point-min))
       (cond
	;; Look for an RCS header
	((re-search-forward "\\$[I]d: [^ ]+ \\([^ ]+\\) " header-max t)
	 (buffer-substring-no-properties (match-beginning 1) (match-end 1)))

	;; Look for an SCCS header
	((re-search-forward 
	  (concat
	   (regexp-quote "@(#)")
	   (regexp-quote (file-name-nondirectory (buffer-file-name)))
	   "\t\\([012345679.]*\\)")
	  header-max t)
	 (buffer-substring-no-properties (match-beginning 1) (match-end 1)))

	(t nil))))))
Eric S. Raymond's avatar
Eric S. Raymond committed
342 343

(defun lm-keywords (&optional file)
344
  "Return the keywords given in file FILE, or current buffer if FILE is nil."
345 346 347
  (lm-with-file file
    (let ((keywords (lm-header "keywords")))
      (and keywords (downcase keywords)))))
Eric S. Raymond's avatar
Eric S. Raymond committed
348 349

(defun lm-adapted-by (&optional file)
350 351 352
  "Return the adapted-by names in file FILE, or current buffer if FILE is nil.
This is the name of the person who cleaned up this package for
distribution."
353 354
  (lm-with-file file
    (lm-header "adapted-by")))
Eric S. Raymond's avatar
Eric S. Raymond committed
355

356
(defun lm-commentary (&optional file)
357
  "Return the commentary in file FILE, or current buffer if FILE is nil.
Dave Love's avatar
Dave Love committed
358 359 360
The value is returned as a string.  In the file, the commentary starts
with the tag `Commentary' or `Documentation' and ends with one of the
tags `Code', `Change Log' or `History'."
361 362 363 364 365 366 367
  (lm-with-file file
    (let ((commentary	(lm-commentary-mark))
	  (change-log	(lm-history-mark))
	  (code		(lm-code-mark)))
      (when (and commentary (or change-log code))
	(buffer-substring-no-properties
	 commentary (min (or code (point-max)) (or change-log (point-max))))))))
Eric S. Raymond's avatar
Eric S. Raymond committed
368 369 370

;;; Verification and synopses

371
(defun lm-insert-at-column (col &rest strings)
Dave Love's avatar
Dave Love committed
372
  "Insert, at column COL, list of STRINGS."
373
  (if (> (current-column) col) (insert "\n"))
Karl Heuer's avatar
Karl Heuer committed
374
  (move-to-column col t)
375
  (apply 'insert strings))
Eric S. Raymond's avatar
Eric S. Raymond committed
376

Dave Love's avatar
Dave Love committed
377
(defun lm-verify (&optional file showok verb)
Eric S. Raymond's avatar
Eric S. Raymond committed
378
  "Check that the current buffer (or FILE if given) is in proper format.
379
If FILE is a directory, recurse on its files and generate a report in
Eric S. Raymond's avatar
Eric S. Raymond committed
380
a temporary buffer."
381 382 383 384 385 386 387 388 389 390 391 392 393 394 395 396 397 398 399
  (interactive)
  (let* ((verb    (or verb (interactive-p)))
	 ret
	 name
	 )
    (if verb
	(setq ret "Ok."))		;init value

    (if (and file (file-directory-p file))
	(setq
	 ret
	 (progn
	   (switch-to-buffer (get-buffer-create "*lm-verify*"))
	   (erase-buffer)
	   (mapcar
	    '(lambda (f)
	       (if (string-match ".*\\.el$" f)
		   (let ((status (lm-verify f)))
		     (if status
Eric S. Raymond's avatar
Eric S. Raymond committed
400 401
			 (progn
			   (insert f ":")
402 403 404 405 406 407 408
			   (lm-insert-at-column lm-comment-column status "\n"))
		       (and showok
			    (progn
			      (insert f ":")
			      (lm-insert-at-column lm-comment-column "OK\n")))))))
	    (directory-files file))
	   ))
409
      (lm-with-file file
410 411 412 413
	(setq name (lm-get-package-name))

	(setq
	 ret
414 415 416 417 418 419 420 421 422 423 424 425 426 427 428 429 430 431 432 433 434 435 436 437 438 439 440 441 442 443 444 445 446 447 448 449 450
	 (cond
	  ((null name)
	   "Can't find a package NAME")

	  ((not (lm-authors))
	   "Author: tag missing.")

	  ((not (lm-maintainer))
	   "Maintainer: tag missing.")

	  ((not (lm-summary))
	   "Can't find a one-line 'Summary' description")

	  ((not (lm-keywords))
	   "Keywords: tag missing.")

	  ((not (lm-commentary-mark))
	   "Can't find a 'Commentary' section marker.")

	  ((not (lm-history-mark))
	   "Can't find a 'History' section marker.")

	  ((not (lm-code-mark))
	   "Can't find a 'Code' section marker")

	  ((progn
	     (goto-char (point-max))
	     (not
	      (re-search-backward
	       (concat "^;;;[ \t]+" name "[ \t]+ends here[ \t]*$"
		       "\\|^;;;[ \t]+ End of file[ \t]+" name)
	       nil t
	       )))
	   (format "Can't find a footer line for [%s]" name))
	  (t
	   ret))
	  )))
451 452 453 454
    (if verb
	(message ret))
    ret
    ))
Eric S. Raymond's avatar
Eric S. Raymond committed
455 456 457

(defun lm-synopsis (&optional file showall)
  "Generate a synopsis listing for the buffer or the given FILE if given.
458 459
If FILE is a directory, recurse on its files and generate a report in
a temporary buffer.  If SHOWALL is non-nil, also generate a line for files
Eric S. Raymond's avatar
Eric S. Raymond committed
460
which do not include a recognizable synopsis."
461 462 463 464
  (interactive
   (list
    (read-file-name "Synopsis for (file or dir): ")))

Eric S. Raymond's avatar
Eric S. Raymond committed
465 466 467 468 469 470 471 472 473 474 475
  (if (and file (file-directory-p file))
      (progn
	(switch-to-buffer (get-buffer-create "*lm-verify*"))
	(erase-buffer)
	(mapcar
	 '(lambda (f)
	    (if (string-match ".*\\.el$" f)
		(let ((syn (lm-synopsis f)))
		  (if syn
		      (progn
			(insert f ":")
476
			(lm-insert-at-column lm-comment-column syn "\n"))
Eric S. Raymond's avatar
Eric S. Raymond committed
477 478 479
		    (and showall
			 (progn
			   (insert f ":")
480
			   (lm-insert-at-column lm-comment-column "NA\n")))))))
Eric S. Raymond's avatar
Eric S. Raymond committed
481 482
	 (directory-files file))
	)
483 484
    (lm-with-file file
      (lm-summary))))
Eric S. Raymond's avatar
Eric S. Raymond committed
485 486 487

(defun lm-report-bug (topic)
  "Report a bug in the package currently being visited to its maintainer.
Dave Love's avatar
Dave Love committed
488
Prompts for bug subject TOPIC.  Leaves you in a mail buffer."
489
  (interactive "sBug Subject: ")
490 491 492
  (let ((package	(lm-get-package-name))
	(addr		(lm-maintainer))
	(version	(lm-version)))
493 494 495
    (mail nil
	  (if addr
	      (concat (car addr) " <" (cdr addr) ">")
Andreas Schwab's avatar
Andreas Schwab committed
496
	    report-emacs-bug-address)
497
	  topic)
Eric S. Raymond's avatar
Eric S. Raymond committed
498 499 500
    (goto-char (point-max))
    (insert "\nIn "
	    package
501
	    (if version (concat " version " version) "")
Eric S. Raymond's avatar
Eric S. Raymond committed
502
	    "\n\n")
503
    (message
Eric S. Raymond's avatar
Eric S. Raymond committed
504 505 506 507 508
     (substitute-command-keys "Type \\[mail-send] to send bug report."))))

(provide 'lisp-mnt)

;;; lisp-mnt.el ends here
509