;;; lisp-mnt.el --- minor mode for Emacs Lisp maintainers
-;; Copyright (C) 1992 Free Software Foundation, Inc.
+;; Copyright (C) 1992, 1994 Free Software Foundation, Inc.
;; Author: Eric S. Raymond <esr@snark.thyrsus.com>
;; Maintainer: Eric S. Raymond <esr@snark.thyrsus.com>
;; Created: 14 Jul 1992
-;; Version: $Id: lisp-mnt.el,v 1.3 1993/04/14 03:34:42 eric Exp rms $
+;; Version: $Id: lisp-mnt.el,v 1.16 1996/02/06 21:35:20 erik Exp rms $
;; Keywords: docs
-;; Bogus-Bureaucratic-Cruft: Gruad will get you if you don't watch out!
+;; X-Bogus-Bureaucratic-Cruft: Gruad will get you if you don't watch out!
;; 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 1, or (at your option)
+;; 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,
;; 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, 675 Mass Ave, Cambridge, MA 02139, USA.
+;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
;;; Commentary:
;; 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.
-;; The idea behind these two fields is to be able to write a lisp function
+;; The idea behind these two fields is to be able to write a Lisp function
;; 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.
;; author *is* one of the maintainers.)
;;
;; * Keywords line --- used by the finder code (now under construction)
-;; for finding elisp code related to a topic.
+;; for finding Emacs Lisp code related to a topic.
;;
-;; * Bogus-Bureaucratic-Cruft line --- this is a joke. I figured I should
-;; satirize this design before someone else did. Also, it illustrates the
-;; possibility that other headers may be added in the future for new purposes.
+;; * 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.
;;
-;; * Commentary line --- enables lisp code to find the developer's and
+;; * Commentary line --- enables Lisp code to find the developer's and
;; 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.
;;
-;; * Code line --- exists so elisp can know where commentary and/or
+;; * Code line --- exists so Lisp can know where commentary and/or
;; change-log sections end.
;;
;; * Footer line --- marks end-of-file so it can be distinguished from
(require 'picture) ; provides move-to-column-force
(require 'emacsbug)
+;;; Variables:
+
+(defvar lm-header-prefix "^;;*[ \t]+\\(@\(#\)\\)?[ \t]*\\([\$]\\)?"
+ "Prefix that is ignored before the tag.
+For example, you can write the 1st line synopsis string and headers like this
+in your Lisp package:
+
+ ;; @(#) package.el -- pacakge description
+ ;;
+ ;; @(#) $Maintainer: Person Foo Bar $
+
+The @(#) construct is used by unix what(1) and
+then $identifier: doc string $ is used by GNU ident(1)")
+
+(defvar lm-comment-column 16
+ "Column used for placing formatted output.")
+
+(defvar lm-commentary-header "Commentary\\|Documentation"
+ "Regexp which matches start of documentation section.")
+
+(defvar lm-history-header "Change Log\\|History"
+ "Regexp which matches the start of code log section.")
+
+;;; Functions:
+
;; These functions all parse the headers of the current buffer
-(defun lm-section-mark (hd &optional after)
- ;; Return the buffer location of a given section start marker
+(defsubst lm-get-header-re (header &optional mode)
+ "Returns regexp for matching HEADER.
+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]*"))))
+
+(defsubst lm-get-package-name ()
+ "Returns package name by looking at the first line."
+ (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)))
+ (buffer-substring (match-beginning 1) (match-end 1))
+ )))
+
+(defun lm-section-mark (header &optional after)
+ "Return the buffer location of a given section start marker.
+The HEADER is the section mark string to search for.
+If AFTER is non-nil, return the location of the next line."
(save-excursion
(let ((case-fold-search t))
(goto-char (point-min))
- (if (re-search-forward (concat "^;;; " hd ":$") nil t)
+ (if (re-search-forward (lm-get-header-re header 'section) nil t)
(progn
(beginning-of-line)
(if after (forward-line 1))
(point))
nil))))
-(defun lm-code-mark ()
- ;; Return the buffer location of the code start marker
+(defsubst lm-code-mark ()
+ "Return the buffer location of the `Code' start marker."
(lm-section-mark "Code"))
-(defun lm-header (hd)
- ;; Return the contents of a named header
- (goto-char (point-min))
- (let ((case-fold-search t))
- (if (re-search-forward
- (concat "^;; " hd ": \\(.*\\)") (lm-code-mark) t)
- (buffer-substring (match-beginning 1) (match-end 1))
- nil)))
-
-(defun lm-header-multiline (hd)
- ;; Return the contents of a named header, with possible continuation lines.
- ;; Note -- the returned value is a list of strings, one per line.
+(defsubst lm-commentary-mark ()
+ "Return the buffer location of the `Commentary' start marker."
+ (lm-section-mark lm-commentary-header))
+
+(defsubst lm-history-mark ()
+ "Return the buffer location of the `History' start marker."
+ (lm-section-mark lm-history-header))
+
+(defun lm-header (header)
+ "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))
+ (buffer-substring (match-beginning 1) (match-end 1))
+ nil)))
+
+(defun lm-header-multiline (header)
+ "Return the contents of the header named HEADER, with continuation lines.
+The returned value is a list of strings, one per line."
(save-excursion
(goto-char (point-min))
- (let ((res (save-excursion (lm-header hd))))
- (if res
- (progn
- (forward-line 1)
- (setq res (list res))
- (while (looking-at "^;;\t\\(.*\\)")
- (setq res (cons (buffer-substring
- (match-beginning 1)
- (match-end 1))
- res))
- (forward-line 1))
- ))
- res)))
+ (let ((res (lm-header header)))
+ (cond
+ (res
+ (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))
+ (setq res (cons (buffer-substring
+ (match-beginning 1)
+ (match-end 1))
+ res))
+ (forward-line 1))
+ ))
+ res
+ )))
;; These give us smart access to the header fields and commentary
(defun lm-summary (&optional file)
- ;; Return the buffer's or FILE's one-line summary.
+ "Return the one-line summary of file FILE, or current buffer if FILE is nil."
(save-excursion
(if file
(find-file file))
(goto-char (point-min))
(prog1
- (if (looking-at "^;;; [^ ]+ --- \\(.*\\)")
+ (if (and
+ (looking-at lm-header-prefix)
+ (progn (goto-char (match-end 0))
+ (looking-at "[^ ]+[ \t]+--+[ \t]+\\(.*\\)")))
(buffer-substring (match-beginning 1) (match-end 1)))
(if file
(kill-buffer (current-buffer)))
)))
-
(defun lm-crack-address (x)
- ;; Given a string containing a human and email address, parse it
- ;; into a cons pair (name . address).
+ "Split up an email address into full name and real email address.
+The value is a cons of the form (FULLNAME . ADDRESS)."
(cond ((string-match "\\(.+\\) [(<]\\(\\S-+@\\S-+\\)[>)]" x)
(cons (substring x (match-beginning 1) (match-end 1))
(substring x (match-beginning 2) (match-end 2))))
(cons x nil))))
(defun lm-authors (&optional file)
- ;; Return the buffer's or FILE's author list. Each element of the
- ;; list is a cons; the car is a name-aming-humans, the cdr an email
- ;; address.
+ "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."
(save-excursion
(if file
(find-file file))
))))
(defun lm-maintainer (&optional file)
- ;; Get a package's bug-report & maintenance address. Parse it out of FILE,
- ;; or the current buffer if FILE is nil.
- ;; The return value is a (name . address) cons.
+ "Return the maintainer of file FILE, or current buffer if FILE is nil.
+The return value has the form (NAME . ADDRESS)."
(save-excursion
(if file
(find-file file))
)))
(defun lm-creation-date (&optional file)
- ;; Return a package's creation date, if any. Parse it out of FILE,
- ;; or the current buffer if FILE is nil.
+ "Return the created date given in file FILE, or current buffer if FILE is nil."
(save-excursion
(if file
(find-file file))
(defun lm-last-modified-date (&optional file)
- ;; Return a package's last-modified date, if you can find one.
+ "Return the modify-date given in file FILE, or current buffer if FILE is nil."
(save-excursion
(if file
(find-file file))
)))
(defun lm-version (&optional file)
- ;; Return the package's version field.
- ;; If none, look for an RCS or SCCS header to crack it out of.
+ "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."
(save-excursion
(if file
(find-file file))
)))
(defun lm-keywords (&optional file)
- ;; Return the header containing the package's topic keywords.
- ;; Parse them out of FILE, or the current buffer if FILE is nil.
+ "Return the keywords given in file FILE, or current buffer if FILE is nil."
(save-excursion
(if file
(find-file file))
)))
(defun lm-adapted-by (&optional file)
- ;; Return the name or code of the person who cleaned up this package
- ;; for distribution. Parse it out of FILE, or the current buffer if
- ;; FILE is nil.
+ "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."
(save-excursion
(if file
(find-file file))
)))
(defun lm-commentary (&optional file)
- ;; Return the commentary region of a file, as a string.
+ "Return the commentary in file FILE, or current buffer if FILE is nil.
+The value is returned as a string. In the text, the commentary starts
+with tag `Commentary' and ends with tag `Change Log' or `History'."
(save-excursion
(if file
(find-file file))
(prog1
- (let ((commentary (lm-section-mark "Commentary" t))
- (change-log (lm-section-mark "Change Log"))
- (code (lm-section-mark "Code")))
- (and commentary
- (if change-log
- (buffer-substring commentary change-log)
- (buffer-substring commentary code)))
- )
+ (let ((commentary (lm-commentary-mark))
+ (change-log (lm-history-mark))
+ (code (lm-code-mark))
+ )
+ (cond
+ ((and commentary change-log)
+ (buffer-substring commentary change-log))
+ ((and commentary code)
+ (buffer-substring commentary code))
+ (t
+ nil)))
(if file
(kill-buffer (current-buffer)))
)))
;;; Verification and synopses
-(defun insert-at-column (col &rest pieces)
- (if (> (current-column) col) (insert "\n"))
- (move-to-column-force col)
- (apply 'insert pieces))
-
-(defconst lm-comment-column 16)
+(defun lm-insert-at-column (col &rest strings)
+ "Insert list of STRINGS, at column COL."
+ (if (> (current-column) col) (insert "\n"))
+ (move-to-column-force col)
+ (apply 'insert strings))
-(defun lm-verify (&optional file showok)
+(defun lm-verify (&optional file showok &optional verb)
"Check that the current buffer (or FILE if given) is in proper format.
-If FILE is a directory, recurse on its files and generate a report into
+If FILE is a directory, recurse on its files and generate a report in
a temporary buffer."
- (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 ((status (lm-verify f)))
- (if status
- (progn
- (insert f ":")
- (insert-at-column lm-comment-column status "\n"))
- (and showok
+ (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
(progn
(insert f ":")
- (insert-at-column lm-comment-column "OK\n")))))))
- (directory-files file))
- )
- (save-excursion
- (if file
- (find-file file))
- (prog1
- (cond
- ((not (lm-summary))
- "Can't find a package summary")
- ((not (lm-code-mark))
- "Can't find a code section marker")
- ((progn
- (goto-char (point-max))
- (forward-line -1)
- (looking-at (concat ";;; " file "ends here")))
- "Can't find a footer line")
- )
- (if file
- (kill-buffer (current-buffer)))
- ))))
+ (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))
+ ))
+ (save-excursion
+ (if file
+ (find-file file))
+ (setq name (lm-get-package-name))
+
+ (setq
+ ret
+ (prog1
+ (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))
+ (if file
+ (kill-buffer (current-buffer)))
+ ))))
+ (if verb
+ (message ret))
+ ret
+ ))
(defun lm-synopsis (&optional file showall)
"Generate a synopsis listing for the buffer or the given FILE if given.
-If FILE is a directory, recurse on its files and generate a report into
-a temporary buffer. If SHOWALL is on, also generate a line for files
+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
which do not include a recognizable synopsis."
+ (interactive
+ (list
+ (read-file-name "Synopsis for (file or dir): ")))
+
(if (and file (file-directory-p file))
(progn
(switch-to-buffer (get-buffer-create "*lm-verify*"))
(if syn
(progn
(insert f ":")
- (insert-at-column lm-comment-column syn "\n"))
+ (lm-insert-at-column lm-comment-column syn "\n"))
(and showall
(progn
(insert f ":")
- (insert-at-column lm-comment-column "NA\n")))))))
+ (lm-insert-at-column lm-comment-column "NA\n")))))))
(directory-files file))
)
(save-excursion
"Report a bug in the package currently being visited to its maintainer.
Prompts for bug subject. Leaves you in a mail buffer."
(interactive "sBug Subject: ")
- (let ((package (buffer-name))
- (addr (lm-maintainer))
- (version (lm-version)))
- (mail nil (or addr bug-gnu-emacs) topic)
+ (let ((package (lm-get-package-name))
+ (addr (lm-maintainer))
+ (version (lm-version)))
+ (mail nil
+ (if addr
+ (concat (car addr) " <" (cdr addr) ">")
+ bug-gnu-emacs)
+ topic)
(goto-char (point-max))
(insert "\nIn "
package
- (and version (concat " version " version))
+ (if version (concat " version " version) "")
"\n\n")
(message
(substitute-command-keys "Type \\[mail-send] to send bug report."))))
(provide 'lisp-mnt)
;;; lisp-mnt.el ends here
+