Fix bzr command cache to pay attention to timestamp of workfile.

diff --git a/v7/src/edwin/vc.scm b/v7/src/edwin/vc.scm
index 37801b5400ddb95e2c9b8238c511c78d90d215bf..02affcdc57ca551df17fe40a7bc2184348296fe3 100644 (file)
--- a/v7/src/edwin/vc.scm
+++ b/v7/src/edwin/vc.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: vc.scm,v 1.100 2007/10/17 18:50:22 cph Exp $
+$Id: vc.scm,v 1.101 2007/10/18 15:57:40 cph Exp $
 
 Copyright (C) 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1994,
     1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
@@ -2522,24 +2522,6 @@ the value of vc-log-mode-hook."
              ((pair? (cdr path)) (loop (except-last-pair path)))
              (else #f))))))
 
-(define (get-bzr-status workfile #!optional required?)
-  (let ((workfile
-        (if (vc-master? workfile)
-            (vc-master-workfile workfile)
-            workfile)))
-    (or (parse-bzr-status (%get-bzr-status workfile))
-       (cond ((bzr-workfile-versioned? workfile)
-              (make-bzr-status 'VERSIONED 'UNMODIFIED #f))
-             ((bzr-workfile-ignored? workfile)
-              (make-bzr-status 'UNVERSIONED 'UNMODIFIED #f))
-             ((bzr-workfile-unknown? workfile)
-              (make-bzr-status 'UNKNOWN 'UNMODIFIED #f))
-             (else
-              (if (if (default-object? required?) #f required?)
-                  (error "Unable to determine Bazaar status of file:"
-                         workfile))
-              #f)))))
-
 (define (bzr-workfile-versioned? workfile)
   (%bzr-ls-test workfile "--versioned"))
 
@@ -2556,23 +2538,28 @@ the value of vc-log-mode-hook."
                                                  (file-namestring workfile)
                                                  "$")
                                   result))))
-\f
-(define (%get-bzr-status workfile)
-  (%bzr-run-command workfile "status" "--short" (file-namestring workfile)))
 
 (define (%bzr-run-command workfile command . args)
-  (let ((alist (1d-table/get %bzr-command-cache workfile '()))
+  (let ((entry
+        (hash-table/intern! %bzr-command-cache (->namestring workfile)
+          (lambda ()
+            (list -1))))
+       (t (file-modification-time workfile))
        (key (cons command args)))
-    (let ((p (assoc key alist)))
-      (if p
-         (cdr p)
-         (let ((result (%bzr-run-command-1 workfile command args)))
-           (1d-table/put! %bzr-command-cache
-                          workfile
-                          (cons (cons key result) alist))
-           result)))))
-
-(define %bzr-command-cache (make-1d-table))
+    (if (= t (car entry))
+       (let ((p (assoc key (cdr entry))))
+         (if p
+             (cdr p)
+             (let ((result (%bzr-run-command-1 workfile command args)))
+               (set-cdr! entry (cons (cons key result) (cdr entry)))
+               result)))
+       (let ((result (%bzr-run-command-1 workfile command args)))
+         (set-cdr! entry (list (cons key result)))
+         (set-car! entry t)
+         result))))
+
+(define %bzr-command-cache
+  (make-string-hash-table))
 
 (define (%bzr-run-command-1 workfile command args)
   (let ((directory (directory-pathname workfile)))
@@ -2587,6 +2574,27 @@ the value of vc-log-mode-hook."
                     'working-directory directory)))
               (and (eqv? status 0)
                    (get-output-string port))))))))
+\f
+(define (get-bzr-status workfile #!optional required?)
+  (let ((workfile
+        (if (vc-master? workfile)
+            (vc-master-workfile workfile)
+            workfile)))
+    (or (parse-bzr-status (%get-bzr-status workfile))
+       (cond ((bzr-workfile-versioned? workfile)
+              (make-bzr-status 'VERSIONED 'UNMODIFIED #f))
+             ((bzr-workfile-ignored? workfile)
+              (make-bzr-status 'UNVERSIONED 'UNMODIFIED #f))
+             ((bzr-workfile-unknown? workfile)
+              (make-bzr-status 'UNKNOWN 'UNMODIFIED #f))
+             (else
+              (if (if (default-object? required?) #f required?)
+                  (error "Unable to determine Bazaar status of file:"
+                         workfile))
+              #f)))))
+
+(define (%get-bzr-status workfile)
+  (%bzr-run-command workfile "status" "--short" (file-namestring workfile)))
 
 (define (parse-bzr-status status)
   (and status