mirror of
git://git.sv.gnu.org/emacs.git
synced 2025-12-15 10:30:25 -08:00
(lm-header-multiline): fix spurious use of `cond'.
(lm-with-file): Move all the find-file...kill-buffer stuff into this macro. Make it use `find-file-noselect' and make it kill the buffer only if it wasn't already displayed somewhere. (lm-summary, lm-authors, lm-maintainer, lm-creation-date) (lm-last-modified-date, lm-version, lm-keywords, lm-adapted-by) (lm-commentary, lm-verify, lm-synopsis): use lm-with-file. (lm-commentary): fix to handle the case when the change log is at the end of the file.
This commit is contained in:
Stefan Monnier
parent
867ef43ab1
commit
be961cd5aa
2 changed files with 121 additions and 170 deletions
|
|
@ -218,8 +218,7 @@ The returned value is a list of strings, one per line."
|
|||
(save-excursion
|
||||
(goto-char (point-min))
|
||||
(let ((res (lm-header header)))
|
||||
(cond
|
||||
(res
|
||||
(when res
|
||||
(setq res (list res))
|
||||
(forward-line 1)
|
||||
|
||||
|
|
@ -233,32 +232,37 @@ The returned value is a list of strings, one per line."
|
|||
(match-end 1))
|
||||
res))
|
||||
(forward-line 1))
|
||||
))
|
||||
)
|
||||
res
|
||||
)))
|
||||
|
||||
;; These give us smart access to the header fields and commentary
|
||||
|
||||
(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)
|
||||
|
||||
(defun lm-summary (&optional file)
|
||||
"Return the one-line summary of file FILE, or current buffer if FILE is nil."
|
||||
(save-excursion
|
||||
(if file
|
||||
(find-file file))
|
||||
(lm-with-file file
|
||||
(goto-char (point-min))
|
||||
(prog1
|
||||
(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)))
|
||||
(if file
|
||||
(kill-buffer (current-buffer)))
|
||||
)))
|
||||
(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)))))
|
||||
|
||||
(defun lm-crack-address (x)
|
||||
"Split up an email address X into full name and real email address.
|
||||
|
|
@ -278,144 +282,89 @@ The value is a cons of the form (FULLNAME . 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))
|
||||
(lm-with-file file
|
||||
(let ((authorlist (lm-header-multiline "author")))
|
||||
(prog1
|
||||
(mapcar 'lm-crack-address authorlist)
|
||||
(if file
|
||||
(kill-buffer (current-buffer)))
|
||||
))))
|
||||
(mapcar 'lm-crack-address authorlist))))
|
||||
|
||||
(defun lm-maintainer (&optional file)
|
||||
"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))
|
||||
(prog1
|
||||
(let ((maint (lm-header "maintainer")))
|
||||
(if maint
|
||||
(lm-crack-address maint)
|
||||
(car (lm-authors))))
|
||||
(if file
|
||||
(kill-buffer (current-buffer)))
|
||||
)))
|
||||
(lm-with-file file
|
||||
(let ((maint (lm-header "maintainer")))
|
||||
(if maint
|
||||
(lm-crack-address maint)
|
||||
(car (lm-authors))))))
|
||||
|
||||
(defun lm-creation-date (&optional file)
|
||||
"Return the created date given in file FILE, or current buffer if FILE is nil."
|
||||
(save-excursion
|
||||
(if file
|
||||
(find-file file))
|
||||
(prog1
|
||||
(lm-header "created")
|
||||
(if file
|
||||
(kill-buffer (current-buffer)))
|
||||
)))
|
||||
(lm-with-file file
|
||||
(lm-header "created")))
|
||||
|
||||
|
||||
(defun lm-last-modified-date (&optional file)
|
||||
"Return the modify-date given in file FILE, or current buffer if FILE is nil."
|
||||
(save-excursion
|
||||
(if file
|
||||
(find-file file))
|
||||
(prog1
|
||||
(if (progn
|
||||
(goto-char (point-min))
|
||||
(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))
|
||||
))
|
||||
(if file
|
||||
(kill-buffer (current-buffer)))
|
||||
)))
|
||||
(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))))))
|
||||
|
||||
(defun lm-version (&optional file)
|
||||
"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))
|
||||
(prog1
|
||||
(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)))
|
||||
(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)))
|
||||
;; 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))))
|
||||
(if file
|
||||
(kill-buffer (current-buffer)))
|
||||
)))
|
||||
(t nil))))))
|
||||
|
||||
(defun lm-keywords (&optional file)
|
||||
"Return the keywords given in file FILE, or 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)))
|
||||
)))
|
||||
(lm-with-file file
|
||||
(let ((keywords (lm-header "keywords")))
|
||||
(and keywords (downcase keywords)))))
|
||||
|
||||
(defun lm-adapted-by (&optional file)
|
||||
"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))
|
||||
(prog1
|
||||
(lm-header "adapted-by")
|
||||
(if file
|
||||
(kill-buffer (current-buffer)))
|
||||
)))
|
||||
(lm-with-file file
|
||||
(lm-header "adapted-by")))
|
||||
|
||||
(defun lm-commentary (&optional file)
|
||||
"Return the commentary in file FILE, or current buffer if FILE is nil.
|
||||
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'."
|
||||
(save-excursion
|
||||
(if file
|
||||
(find-file file))
|
||||
(prog1
|
||||
(let ((commentary (lm-commentary-mark))
|
||||
(change-log (lm-history-mark))
|
||||
(code (lm-code-mark))
|
||||
)
|
||||
(cond
|
||||
((and commentary change-log)
|
||||
(buffer-substring-no-properties commentary change-log))
|
||||
((and commentary code)
|
||||
(buffer-substring-no-properties commentary code))
|
||||
(t
|
||||
nil)))
|
||||
(if file
|
||||
(kill-buffer (current-buffer)))
|
||||
)))
|
||||
(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))))))))
|
||||
|
||||
;;; Verification and synopses
|
||||
|
||||
|
|
@ -457,53 +406,48 @@ a temporary buffer."
|
|||
(lm-insert-at-column lm-comment-column "OK\n")))))))
|
||||
(directory-files file))
|
||||
))
|
||||
(save-excursion
|
||||
(if file
|
||||
(find-file file))
|
||||
(lm-with-file file
|
||||
(setq name (lm-get-package-name))
|
||||
|
||||
(setq
|
||||
ret
|
||||
(prog1
|
||||
(cond
|
||||
((null name)
|
||||
"Can't find a package NAME")
|
||||
(cond
|
||||
((null name)
|
||||
"Can't find a package NAME")
|
||||
|
||||
((not (lm-authors))
|
||||
"Author: tag missing.")
|
||||
((not (lm-authors))
|
||||
"Author: tag missing.")
|
||||
|
||||
((not (lm-maintainer))
|
||||
"Maintainer: tag missing.")
|
||||
((not (lm-maintainer))
|
||||
"Maintainer: tag missing.")
|
||||
|
||||
((not (lm-summary))
|
||||
"Can't find a one-line 'Summary' description")
|
||||
((not (lm-summary))
|
||||
"Can't find a one-line 'Summary' description")
|
||||
|
||||
((not (lm-keywords))
|
||||
"Keywords: tag missing.")
|
||||
((not (lm-keywords))
|
||||
"Keywords: tag missing.")
|
||||
|
||||
((not (lm-commentary-mark))
|
||||
"Can't find a 'Commentary' section marker.")
|
||||
((not (lm-commentary-mark))
|
||||
"Can't find a 'Commentary' section marker.")
|
||||
|
||||
((not (lm-history-mark))
|
||||
"Can't find a 'History' section marker.")
|
||||
((not (lm-history-mark))
|
||||
"Can't find a 'History' section marker.")
|
||||
|
||||
((not (lm-code-mark))
|
||||
"Can't find a 'Code' 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)))
|
||||
))))
|
||||
((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 verb
|
||||
(message ret))
|
||||
ret
|
||||
|
|
@ -536,14 +480,8 @@ which do not include a recognizable synopsis."
|
|||
(lm-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)))
|
||||
))))
|
||||
(lm-with-file file
|
||||
(lm-summary))))
|
||||
|
||||
(defun lm-report-bug (topic)
|
||||
"Report a bug in the package currently being visited to its maintainer.
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue