Commit be961cd5 authored by Stefan Monnier's avatar Stefan Monnier

(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>
* international/mule.el (charsetp): Fix typo in docstring.
......@@ -42,7 +55,7 @@
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.
(auto-insert): Return nil.
......
......@@ -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)))
;; 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)))
)))
(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)))
(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")
((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)))
))))
(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 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.
......
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