(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.

2 files changed, 131 insertions, 180 deletions

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 93100dc18ec..1fc84e33fab 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,16 @@
+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.
diff --git a/lisp/emacs-lisp/lisp-mnt.el b/lisp/emacs-lisp/lisp-mnt.el
index 47e64294699..3e15384d028 100644
--- a/lisp/emacs-lisp/lisp-mnt.el
+++ b/lisp/emacs-lisp/lisp-mnt.el
@@ -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.