[Cl-darcs-cvs] r60 - cl-darcs/trunk

[mhenoch at common-lisp.net]

Author: mhenoch
Date: Sun Oct 22 08:38:57 2006
New Revision: 60

Modified:
   cl-darcs/trunk/apply-patch.lisp
   cl-darcs/trunk/prefs.lisp
Log:
Add has-prefs-dir.  Don't apply CHANGE-PREF-PATCHes unless there is a prefs directory.


Modified: cl-darcs/trunk/apply-patch.lisp
==============================================================================
--- cl-darcs/trunk/apply-patch.lisp	(original)
+++ cl-darcs/trunk/apply-patch.lisp	Sun Oct 22 08:38:57 2006
@@ -89,15 +89,18 @@
   (apply-patch-list (patches patch) repodir))
 
 (defmethod apply-patch ((patch change-pref-patch) repodir)
-  (with-accessors ((pref change-pref-which)
-		   (from change-pref-from)
-		   (to change-pref-to)) patch
-    (let ((old-value (or (get-pref repodir pref) "")))
-      (unless (string= from old-value)
-	(warn
-	 "While changing pref ~S to ~S, expected old value to be ~S, but it was ~S."
-	 pref to from old-value))
-      (set-pref repodir pref to))))
+  ;; Maybe we're applying the patch to a pristine directory, in which
+  ;; case we don't care about preferences.
+  (when (has-prefs-dir repodir)
+    (with-accessors ((pref change-pref-which)
+		     (from change-pref-from)
+		     (to change-pref-to)) patch
+      (let ((old-value (or (get-pref repodir pref) "")))
+	(unless (string= from old-value)
+	  (warn
+	   "While changing pref ~S to ~S, expected old value to be ~S, but it was ~S."
+	   pref to from old-value))
+	(set-pref repodir pref to)))))
 
 (defmethod apply-patch ((patch add-file-patch) repodir)
   "Create a file in REPODIR, by PATCH."

Modified: cl-darcs/trunk/prefs.lisp
==============================================================================
--- cl-darcs/trunk/prefs.lisp	(original)
+++ cl-darcs/trunk/prefs.lisp	Sun Oct 22 08:38:57 2006
@@ -16,6 +16,13 @@
 
 (in-package :darcs)
 
+(defun has-prefs-dir (repo)
+  "Return true if REPO has a _darcs/prefs subdirectory."
+  ;; This is currently only used for checking whether we should write
+  ;; preferences, so it doesn't matter that this implementation
+  ;; doesn't work for HTTP.
+  (fad:directory-exists-p (upath-subdir repo '("_darcs" "prefs"))))
+
 (defun read-prefs (upath)
   "Read all preferences from repository at UPATH.
 Return an alist with strings."