From: Chris Hanson <org/chris-hanson/cph>
Date: Tue, 26 Oct 1993 21:46:08 +0000 (+0000)
Subject: Don't automatically delete a tags-search buffer unless that buffer
X-Git-Tag: 20090517-FFI~7688
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=4a5c83214d6ecb4cfd0bfcfcc288d5a7de81b057;p=mit-scheme.git

Don't automatically delete a tags-search buffer unless that buffer
truly hasn't been modified.  Previously, this was detected by checking
the MODIFIED? flag of the buffer, but that is cleared if the file is
written out.  Now, it checks to see if any modifications have occurred
since the file was read in.
---

diff --git a/v7/src/edwin/tagutl.scm b/v7/src/edwin/tagutl.scm
index cf1228e85..fbddb8efb 100644
--- a/v7/src/edwin/tagutl.scm
+++ b/v7/src/edwin/tagutl.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;	$Id: tagutl.scm,v 1.51 1993/08/10 09:39:53 cph Exp $
+;;;	$Id: tagutl.scm,v 1.52 1993/10/26 21:46:08 cph Exp $
 ;;;
 ;;;	Copyright (c) 1986, 1989-93 Massachusetts Institute of Technology
 ;;;
@@ -322,7 +322,6 @@ command."
 
 (define tags-loop-continuation false)
 (define tags-loop-pathnames)
-(define buffer-visited-already? false)
 (define tags-loop-current-buffer false)
 
 (define (tags-loop-start)
@@ -330,21 +329,37 @@ command."
     (if (null? pathnames)
 	(editor-error "All files processed."))
     (set! tags-loop-pathnames (cdr pathnames))
-    (set! buffer-visited-already?
-	  (if (pathname->buffer (car pathnames)) true false))
-    (find-file (car pathnames))
-    (message "Scanning file "
-	     (->namestring (buffer-truename (current-buffer)))
-	     "...")
-    (set-current-point! (buffer-start (current-buffer)))
-    (set! tags-loop-current-buffer (current-buffer))
+    (let ((buffer
+	   (let ((buffer (pathname->buffer (car pathnames))))
+	     (if buffer
+		 (begin
+		   (select-buffer buffer)
+		   (buffer-remove! buffer 'TAGS-LOOP-MODIFIED-TICK)
+		   buffer)
+		 (let ((buffer (find-file-noselect (car pathnames) #t)))
+		   (buffer-put! buffer
+				'TAGS-LOOP-MODIFIED-TICK
+				(buffer-modified-tick buffer))
+		   buffer)))))
+      (message "Scanning file " (->namestring (buffer-truename buffer)) "...")
+      (select-buffer buffer)
+      (set-current-point! (buffer-start buffer))
+      (set! tags-loop-current-buffer buffer))
     (tags-loop-continuation)))
 
 (define (smart-buffer-kill)
-  (if (and (not buffer-visited-already?)
-	   (not (buffer-modified? tags-loop-current-buffer))
-	   (ref-variable new-tags-behavior?))
-      (kill-buffer tags-loop-current-buffer)))
+  (let ((buffer tags-loop-current-buffer))
+    (if (and (ref-variable new-tags-behavior? buffer)
+	     (let ((tick (buffer-get buffer 'TAGS-LOOP-MODIFIED-TICK)))
+	       (and tick
+		    (fix:= tick (buffer-modified-tick buffer)))))
+	(kill-buffer buffer)
+	(buffer-remove! buffer 'TAGS-LOOP-MODIFIED-TICK)))
+  (set! tags-loop-current-buffer #f)
+  unspecific)
+
+(define (buffer-modified-tick buffer)
+  (group-modified-tick (buffer-group buffer)))
 
 (define-variable new-tags-behavior?
   "This variable controls the behavior of tags-search and