# HG changeset patch # User Stefan Monnier # Date 944152041 0 # Node ID 1006a8324029295317bf78f7ec13cdd6870222b0 # Parent edf998fc73b40f13e48a7e26a704fc54073bd7d5 (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. diff -r edf998fc73b4 -r 1006a8324029 lisp/ChangeLog --- a/lisp/ChangeLog Thu Dec 02 14:38:17 1999 +0000 +++ b/lisp/ChangeLog Thu Dec 02 16:27:21 1999 +0000 @@ -1,3 +1,16 @@ +1999-12-02 Stefan Monnier + + * 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 * international/mule.el (charsetp): Fix typo in docstring. @@ -42,7 +55,7 @@ 1999-11-30 Dave Love - * 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. diff -r edf998fc73b4 -r 1006a8324029 lisp/emacs-lisp/lisp-mnt.el --- a/lisp/emacs-lisp/lisp-mnt.el Thu Dec 02 14:38:17 1999 +0000 +++ b/lisp/emacs-lisp/lisp-mnt.el Thu Dec 02 16:27:21 1999 +0000 @@ -218,8 +218,7 @@ (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 @@ (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 @@ "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 @@ (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 @@ (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.