Skip to content
GitLab
Projects
Groups
Snippets
Help
Loading...
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in / Register
Toggle navigation
Open sidebar
emacs
emacs
Commits
0fc37e7d
Commit
0fc37e7d
authored
Jul 27, 1992
by
Eric S. Raymond
Browse files
entered into RCS
parent
ab67260b
Changes
1
Hide whitespace changes
Inline
Side-by-side
Showing
1 changed file
with
423 additions
and
0 deletions
+423
-0
lisp/emacs-lisp/lisp-mnt.el
lisp/emacs-lisp/lisp-mnt.el
+423
-0
No files found.
lisp/emacs-lisp/lisp-mnt.el
0 → 100644
View file @
0fc37e7d
;;; lisp-mnt.el --- minor mode for Emacs Lisp maintainers
;; Copyright (C) 1992 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
;; Keywords: docs
;; 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)
;; 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, 675 Mass Ave, Cambridge, MA 02139, USA.
;;; 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.
;;
;; If there are multible authors, they should be listed on continuation
;; 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.
;; 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.
;;
;; * 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
;; at a different version of the file than the one they're accustomed to. Not
;; needed if you have 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
;; 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)
;; for finding elisp 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.
;;
;; * 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
;; 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:
(
require
'picture
)
; provides move-to-column-force
;; These functions all parse the headers of the current buffer
(
defun
lm-section-mark
(
hd
)
;; 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
)
(
progn
(
beginning-of-line
)
(
point
))
nil
))))
(
defun
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.
(
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
)))
;; 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.
(
save-excursion
(
if
file
(
find-file
file
))
(
goto-char
(
point-min
))
(
prog1
(
if
(
looking-at
"^;;; [^ ]+ --- \\(.*\\)"
)
(
buffer-substring
(
match-beginning
1
)
(
match-end
1
)))
(
if
file
(
kill-buffer
(
current-buffer
)))
)))
(
defun
lm-authors
(
&optional
file
)
;; Return the buffer's or FILE's author list.
(
save-excursion
(
if
file
(
find-file
file
))
(
prog1
(
lm-header-multiline
"author"
)
(
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,
(
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
))
)
(
if
file
(
kill-buffer
(
current-buffer
)))
)))
(
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.
(
save-excursion
(
if
file
(
find-file
file
))
(
prog1
(
lm-header
"created"
)
(
if
file
(
kill-buffer
(
current-buffer
)))
)))
(
defun
lm-last-modified-date
(
&optional
file
)
;; Return a package's last-modified date, if you can find one.
(
save-excursion
(
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
file
(
kill-buffer
(
current-buffer
)))
))
(
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.
(
save-excursion
(
if
file
(
find-file
file
))
(
prog1
(
or
(
lm-header
"version"
)
(
let
((
header-max
(
lm-code-mark
)))
(
goto-char
(
point-min
))
(
cond
;; Look for an RCS header
((
re-search-forward
"\\$Id: [^ ]+ \\([^ ]+\\) "
header-max
t
)
(
buffer-substring
(
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
(
match-beginning
1
)
(
match-end
1
)))
(
t
nil
))))
(
if
file
(
kill-buffer
(
current-buffer
)))
)))
(
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.
(
save-excursion
(
if
file
(
find-file
file
))
(
prog1
(
let
((
keywords
(
lm-header
"keywords"
)))
(
and
keywords
(
downcase
keywords
)))
(
if
file
(
kill-buffer
(
current-buffer
)))
)))
(
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.
(
save-excursion
(
if
file
(
find-file
file
))
(
prog1
(
lm-header
"adapted-by"
)
(
if
file
(
kill-buffer
(
current-buffer
)))
)))
(
defun
lm-commentary-region
(
&optional
file
)
;; Return a pair of character locations enclosing the commentary region.
(
save-excursion
(
if
file
(
find-file
file
))
(
prog1
(
let
((
commentary
(
lm-section-mark
"Commentary"
))
(
change-log
(
lm-section-mark
"Change Log"
))
(
code
(
lm-section-mark
"Code"
)))
(
if
commentary
(
if
change-log
(
cons
commentary
change-log
)
(
cons
commentary
code
)))
)
(
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-verify
(
&optional
file
showok
)
"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
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
(
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
)))
))))
(
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
which do not include a recognizable synopsis."
(
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
":"
)
(
insert-at-column
lm-comment-column
syn
"\n"
))
(
and
showall
(
progn
(
insert
f
":"
)
(
insert-at-column
lm-comment-column
"NA\n"
)))))))
(
directory-files
file
))
)
(
save-excursion
(
if
file
(
find-file
file
))
(
prog1
(
lm-summary
)
(
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."
(
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
)
(
goto-char
(
point-max
))
(
insert
"\nIn "
package
(
and
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
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
.
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment