Mercurial > emacs

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