(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 --git a/lisp/ChangeLog b/lisp/ChangeLog
index 93100dc18eccc9d1939652110a60c222cd6e02b8..1fc84e33fabdf15dc2c4f6d04083db3db8318046 100644 (file)
--- 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 47e64294699bdb6b4b12ba99583c99f142d9559a..3e15384d028df8ae042a94fe72a674e248ba381d 100644 (file)
--- 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.