Commit be961cd5 authored by Stefan Monnier's avatar Stefan Monnier
Browse files

(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.
parent 867ef43a
1999-12-02 Stefan Monnier <monnier@cs.yale.edu>
* emacs-lisp/lisp-mnt.el (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.
1999-12-02 Kenichi Handa <handa@etl.go.jp> 1999-12-02 Kenichi Handa <handa@etl.go.jp>
* international/mule.el (charsetp): Fix typo in docstring. * international/mule.el (charsetp): Fix typo in docstring.
...@@ -42,7 +55,7 @@ ...@@ -42,7 +55,7 @@
1999-11-30 Dave Love <fx@gnu.org> 1999-11-30 Dave Love <fx@gnu.org>
* fortran.el (fortran-strip-sqeuence-nos): New command. * fortran.el (fortran-strip-sequence-nos): New command.
* autoinsert.el: Minor doc fixes. * autoinsert.el: Minor doc fixes.
(auto-insert): Return nil. (auto-insert): Return nil.
......
...@@ -218,8 +218,7 @@ The returned value is a list of strings, one per line." ...@@ -218,8 +218,7 @@ The returned value is a list of strings, one per line."
(save-excursion (save-excursion
(goto-char (point-min)) (goto-char (point-min))
(let ((res (lm-header header))) (let ((res (lm-header header)))
(cond (when res
(res
(setq res (list res)) (setq res (list res))
(forward-line 1) (forward-line 1)
...@@ -233,32 +232,37 @@ The returned value is a list of strings, one per line." ...@@ -233,32 +232,37 @@ The returned value is a list of strings, one per line."
(match-end 1)) (match-end 1))
res)) res))
(forward-line 1)) (forward-line 1))
)) )
res res
))) )))
;; These give us smart access to the header fields and commentary ;; 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) (defun lm-summary (&optional file)
"Return the one-line summary of file FILE, or current buffer if FILE is nil." "Return the one-line summary of file FILE, or current buffer if FILE is nil."
(save-excursion (lm-with-file file
(if file
(find-file file))
(goto-char (point-min)) (goto-char (point-min))
(prog1 (if (and
(if (and (looking-at lm-header-prefix)
(looking-at lm-header-prefix) (progn (goto-char (match-end 0))
(progn (goto-char (match-end 0)) (looking-at "[^ ]+[ \t]+--+[ \t]+\\(.*\\)")))
(looking-at "[^ ]+[ \t]+--+[ \t]+\\(.*\\)"))) (let ((summary (buffer-substring-no-properties (match-beginning 1)
(let ((summary (buffer-substring-no-properties (match-beginning 1) (match-end 1))))
(match-end 1)))) ;; Strip off -*- specifications.
;; Strip off -*- specifications. (if (string-match "[ \t]*-\\*-.*-\\*-" summary)
(if (string-match "[ \t]*-\\*-.*-\\*-" summary) (substring summary 0 (match-beginning 0))
(substring summary 0 (match-beginning 0)) summary)))))
summary)))
(if file
(kill-buffer (current-buffer)))
)))
(defun lm-crack-address (x) (defun lm-crack-address (x)
"Split up an email address X into full name and real email address. "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)." ...@@ -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. "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, Each element of the list is a cons; the car is the full name,
the cdr is an email address." the cdr is an email address."
(save-excursion (lm-with-file file
(if file
(find-file file))
(let ((authorlist (lm-header-multiline "author"))) (let ((authorlist (lm-header-multiline "author")))
(prog1 (mapcar 'lm-crack-address authorlist))))
(mapcar 'lm-crack-address authorlist)
(if file
(kill-buffer (current-buffer)))
))))
(defun lm-maintainer (&optional file) (defun lm-maintainer (&optional file)
"Return the maintainer of file FILE, or current buffer if FILE is nil. "Return the maintainer of file FILE, or current buffer if FILE is nil.
The return value has the form (NAME . ADDRESS)." The return value has the form (NAME . ADDRESS)."
(save-excursion (lm-with-file file
(if file (let ((maint (lm-header "maintainer")))
(find-file file)) (if maint
(prog1 (lm-crack-address maint)
(let ((maint (lm-header "maintainer"))) (car (lm-authors))))))
(if maint
(lm-crack-address maint)
(car (lm-authors))))
(if file
(kill-buffer (current-buffer)))
)))
(defun lm-creation-date (&optional file) (defun lm-creation-date (&optional file)
"Return the created date given in file FILE, or current buffer if FILE is nil." "Return the created date given in file FILE, or current buffer if FILE is nil."
(save-excursion (lm-with-file file
(if file (lm-header "created")))
(find-file file))
(prog1
(lm-header "created")
(if file
(kill-buffer (current-buffer)))
)))
(defun lm-last-modified-date (&optional file) (defun lm-last-modified-date (&optional file)
"Return the modify-date given in file FILE, or current buffer if FILE is nil." "Return the modify-date given in file FILE, or current buffer if FILE is nil."
(save-excursion (lm-with-file file
(if file (goto-char (point-min))
(find-file file)) (when (re-search-forward
(prog1 "\\$[I]d: [^ ]+ [^ ]+ \\([^/]+\\)/\\([^/]+\\)/\\([^ ]+\\) "
(if (progn (lm-code-mark) t)
(goto-char (point-min)) (format "%s %s %s"
(re-search-forward (buffer-substring (match-beginning 3) (match-end 3))
"\\$[I]d: [^ ]+ [^ ]+ \\([^/]+\\)/\\([^/]+\\)/\\([^ ]+\\) " (nth (string-to-int
(lm-code-mark) t)) (buffer-substring (match-beginning 2) (match-end 2)))
(format "%s %s %s" '("" "Jan" "Feb" "Mar" "Apr" "May" "Jun"
(buffer-substring (match-beginning 3) (match-end 3)) "Jul" "Aug" "Sep" "Oct" "Nov" "Dec"))
(nth (string-to-int (buffer-substring (match-beginning 1) (match-end 1))))))
(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) (defun lm-version (&optional file)
"Return the version listed in file FILE, or current buffer if FILE is nil. "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." This can befound in an RCS or SCCS header to crack it out of."
(save-excursion (lm-with-file file
(if file (or
(find-file file)) (lm-header "version")
(prog1 (let ((header-max (lm-code-mark)))
(or (goto-char (point-min))
(lm-header "version") (cond
(let ((header-max (lm-code-mark))) ;; Look for an RCS header
(goto-char (point-min)) ((re-search-forward "\\$[I]d: [^ ]+ \\([^ ]+\\) " header-max t)
(cond (buffer-substring-no-properties (match-beginning 1) (match-end 1)))
;; Look for an RCS header
((re-search-forward "\\$[I]d: [^ ]+ \\([^ ]+\\) " header-max t) ;; Look for an SCCS header
(buffer-substring-no-properties (match-beginning 1) (match-end 1))) ((re-search-forward
(concat
;; Look for an SCCS header (regexp-quote "@(#)")
((re-search-forward (regexp-quote (file-name-nondirectory (buffer-file-name)))
(concat "\t\\([012345679.]*\\)")
(regexp-quote "@(#)") header-max t)
(regexp-quote (file-name-nondirectory (buffer-file-name))) (buffer-substring-no-properties (match-beginning 1) (match-end 1)))
"\t\\([012345679.]*\\)")
header-max t) (t nil))))))
(buffer-substring-no-properties (match-beginning 1) (match-end 1)))
(t nil))))
(if file
(kill-buffer (current-buffer)))
)))
(defun lm-keywords (&optional file) (defun lm-keywords (&optional file)
"Return the keywords given in file FILE, or current buffer if FILE is nil." "Return the keywords given in file FILE, or current buffer if FILE is nil."
(save-excursion (lm-with-file file
(if file (let ((keywords (lm-header "keywords")))
(find-file file)) (and keywords (downcase keywords)))))
(prog1
(let ((keywords (lm-header "keywords")))
(and keywords (downcase keywords)))
(if file
(kill-buffer (current-buffer)))
)))
(defun lm-adapted-by (&optional file) (defun lm-adapted-by (&optional file)
"Return the adapted-by names in file FILE, or 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 This is the name of the person who cleaned up this package for
distribution." distribution."
(save-excursion (lm-with-file file
(if file (lm-header "adapted-by")))
(find-file file))
(prog1
(lm-header "adapted-by")
(if file
(kill-buffer (current-buffer)))
)))
(defun lm-commentary (&optional file) (defun lm-commentary (&optional file)
"Return the commentary in file FILE, or current buffer if FILE is nil. "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 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 with the tag `Commentary' or `Documentation' and ends with one of the
tags `Code', `Change Log' or `History'." tags `Code', `Change Log' or `History'."
(save-excursion (lm-with-file file
(if file (let ((commentary (lm-commentary-mark))
(find-file file)) (change-log (lm-history-mark))
(prog1 (code (lm-code-mark)))
(let ((commentary (lm-commentary-mark)) (when (and commentary (or change-log code))
(change-log (lm-history-mark)) (buffer-substring-no-properties
(code (lm-code-mark)) commentary (min (or code (point-max)) (or change-log (point-max))))))))
)
(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)))
)))
;;; Verification and synopses ;;; Verification and synopses
...@@ -457,53 +406,48 @@ a temporary buffer." ...@@ -457,53 +406,48 @@ a temporary buffer."
(lm-insert-at-column lm-comment-column "OK\n"))))))) (lm-insert-at-column lm-comment-column "OK\n")))))))
(directory-files file)) (directory-files file))
)) ))
(save-excursion (lm-with-file file
(if file
(find-file file))
(setq name (lm-get-package-name)) (setq name (lm-get-package-name))
(setq (setq
ret ret
(prog1 (cond
(cond ((null name)
((null name) "Can't find a package NAME")
"Can't find a package NAME")
((not (lm-authors))
((not (lm-authors)) "Author: tag missing.")
"Author: tag missing.")
((not (lm-maintainer))
((not (lm-maintainer)) "Maintainer: tag missing.")
"Maintainer: tag missing.")
((not (lm-summary))
((not (lm-summary)) "Can't find a one-line 'Summary' description")
"Can't find a one-line 'Summary' description")
((not (lm-keywords))
((not (lm-keywords)) "Keywords: tag missing.")
"Keywords: tag missing.")
((not (lm-commentary-mark))
((not (lm-commentary-mark)) "Can't find a 'Commentary' section marker.")
"Can't find a 'Commentary' section marker.")
((not (lm-history-mark))
((not (lm-history-mark)) "Can't find a 'History' section marker.")
"Can't find a 'History' section marker.")
((not (lm-code-mark))
((not (lm-code-mark)) "Can't find a 'Code' section marker")
"Can't find a 'Code' section marker")
((progn
((progn (goto-char (point-max))
(goto-char (point-max)) (not
(not (re-search-backward
(re-search-backward (concat "^;;;[ \t]+" name "[ \t]+ends here[ \t]*$"
(concat "^;;;[ \t]+" name "[ \t]+ends here[ \t]*$" "\\|^;;;[ \t]+ End of file[ \t]+" name)
"\\|^;;;[ \t]+ End of file[ \t]+" name) nil t
nil t )))
))) (format "Can't find a footer line for [%s]" name))
(format "Can't find a footer line for [%s]" name)) (t
(t ret))
ret)) )))
(if file
(kill-buffer (current-buffer)))
))))
(if verb (if verb
(message ret)) (message ret))
ret ret
...@@ -536,14 +480,8 @@ which do not include a recognizable synopsis." ...@@ -536,14 +480,8 @@ which do not include a recognizable synopsis."
(lm-insert-at-column lm-comment-column "NA\n"))))))) (lm-insert-at-column lm-comment-column "NA\n")))))))
(directory-files file)) (directory-files file))
) )
(save-excursion (lm-with-file file
(if file (lm-summary))))
(find-file file))
(prog1
(lm-summary)
(if file
(kill-buffer (current-buffer)))
))))
(defun lm-report-bug (topic) (defun lm-report-bug (topic)
"Report a bug in the package currently being visited to its maintainer. "Report a bug in the package currently being visited to its maintainer.
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment