;;; 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: 1.2
+;; Version: $Id: lisp-mnt.el,v 1.12 1996/01/14 07:34:30 erik Exp kwzh $
;; 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,
;; 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, 675 Mass Ave, Cambridge, MA 02139, USA.
+;; 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:
;; * Author line --- contains the name and net address of at least
;; the principal author.
;;
-;; If there are multible authors, they should be listed on continuation
+;; If there are multiple authors, they should be listed on continuation
;; lines led by ;;<TAB>, like this:
;;
;; ;; Author: Ashwin Ram <Ram-Ashwin@cs.yale.edu>
;; file. For historical interest, basically.
;;
;; * Version line --- intended to give the reader a clue if they're looking
-;; at a different version of the file than the one they're accustomed to. Not
-;; needed if you have an RCS or SCCS header.
+;; at a different version of the file than the one they're accustomed to. This
+;; may be an RCS or SCCS header.
;;
;; * 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
;; 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
;; 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
;;; Code:
(require 'picture) ; provides move-to-column-force
+(require 'emacsbug)
;; These functions all parse the headers of the current buffer
-(defun lm-section-mark (hd)
+(defun lm-section-mark (hd &optional after)
;; Return the buffer location of a given section start marker
(save-excursion
(let ((case-fold-search t))
(goto-char (point-min))
- (if (re-search-forward (concat "^;;; " hd ":$") nil t)
+ (if (re-search-forward (concat "^;;;;* " hd ":[ \t]*$") nil t)
(progn
(beginning-of-line)
+ (if after (forward-line 1))
(point))
nil))))
(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).
+ (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))))
+
(defun lm-authors (&optional file)
- ;; Return the buffer's or FILE's author list.
+ ;; 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.
(save-excursion
(if file
(find-file file))
- (prog1
- (lm-header-multiline "author")
- (if file
- (kill-buffer (current-buffer)))
- )))
+ (let ((authorlist (lm-header-multiline "author")))
+ (prog1
+ (mapcar 'lm-crack-address authorlist)
+ (if file
+ (kill-buffer (current-buffer)))
+ ))))
(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.
- ;; This may be a name-address pair, or an address by itself,
+ ;; The return value is a (name . address) cons.
(save-excursion
(if file
(find-file file))
(prog1
- (let ((raw-address
- (or
- (save-excursion (lm-header "maintainer"))
- (car (lm-authors)))))
- (cond ((string-match "[^<]<\\([^>]+\\)>" raw-address)
- (substring raw-address (match-beginning 1) (match-end 1)))
- (t raw-address))
- )
+ (let ((maint (lm-header "maintainer")))
+ (if maint
+ (lm-crack-address maint)
+ (car (lm-authors))))
(if file
(kill-buffer (current-buffer)))
)))
(if file
(find-file file))
(prog1
- (if (progn
- (goto-char (point-min))
- (re-search-forward
- "\\$Id: [^ ]+ [^ ]+ \\([^/]+\\)/\\([^/]+\\)/\\([^ ]+\\) "
- (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))
- )))
+ (if (progn
+ (goto-char (point-min))
+ (re-search-forward
+ "\\$Id: [^ ]+ [^ ]+ \\([^/]+\\)/\\([^/]+\\)/\\([^ ]+\\) "
+ (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))
+ ))
(if file
(kill-buffer (current-buffer)))
- ))
+ )))
(defun lm-version (&optional file)
;; Return the package's version field.
(kill-buffer (current-buffer)))
)))
-(defun lm-commentary-region (&optional file)
- ;; Return a pair of character locations enclosing the commentary region.
+(defun lm-commentary (&optional file)
+ ;; Return the commentary region of a file, as a string.
(save-excursion
(if file
(find-file file))
(prog1
- (let ((commentary (lm-section-mark "Commentary"))
+ (let ((commentary (lm-section-mark "Commentary" t))
(change-log (lm-section-mark "Change Log"))
(code (lm-section-mark "Code")))
- (if commentary
+ (and commentary
(if change-log
- (cons commentary change-log)
- (cons commentary code)))
+ (buffer-substring commentary change-log)
+ (buffer-substring commentary code)))
)
(if file
(kill-buffer (current-buffer)))
(defun lm-report-bug (topic)
"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)))
- ;; We do this in order to avoid duplicating the general bug address here
- (if (or (not addr) (string= "FSF"))
- (progn
- (load-library "emacsbug.el")
- (emacsbug (format "%s --- %s" package topic))))
- (interactive "sBug Subject: ")
- (mail nil addr topic)
+ (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
+ (message "%s"
(substitute-command-keys "Type \\[mail-send] to send bug report."))))
(provide 'lisp-mnt)