[rucksack-cvs] CVS rucksack

[alemmens]

Update of /project/rucksack/cvsroot/rucksack
In directory clnet:/tmp/cvs-serv25442

Modified Files:
	cache.lisp transactions.lisp 
Log Message:
Use Erik Naggum's SANS function instead of REMF.  (From Edi Weitz.)


--- /project/rucksack/cvsroot/rucksack/cache.lisp	2006/08/03 18:37:50	1.7
+++ /project/rucksack/cvsroot/rucksack/cache.lisp	2006/08/04 10:37:59	1.8
@@ -1,4 +1,4 @@
-;; $Id: cache.lisp,v 1.7 2006/08/03 18:37:50 alemmens Exp $
+;; $Id: cache.lisp,v 1.8 2006/08/04 10:37:59 alemmens Exp $
 
 (in-package :rucksack)
 
@@ -139,12 +139,29 @@
 
 (defvar *cache* nil)
 
+(defun sans (plist &rest keys)
+  "Returns PLIST with keyword arguments from KEYS removed."
+  ;; stolen from Usenet posting <3247672165664225 at naggum.no> by Erik
+  ;; Naggum
+  (let ((sans ()))
+    (loop
+      (let ((tail (nth-value 2 (get-properties plist keys))))
+        ;; this is how it ends
+        (unless tail
+          (return (nreconc sans plist)))
+        ;; copy all the unmatched keys
+        (loop until (eq plist tail) do
+              (push (pop plist) sans)
+              (push (pop plist) sans))
+        ;; skip the matched key
+        (setq plist (cddr plist))))))
+
 (defun open-cache (directory &rest args
                              &key (class 'standard-cache)
                              &allow-other-keys)
-  (remf args ':class)
   (setq *cache*
-        (apply #'make-instance class :directory directory args)))
+        (apply #'make-instance class :directory directory
+               (sans args :class))))
 
 
 (defmethod close-cache ((cache standard-cache) &key (commit t))
--- /project/rucksack/cvsroot/rucksack/transactions.lisp	2006/08/03 18:37:50	1.6
+++ /project/rucksack/cvsroot/rucksack/transactions.lisp	2006/08/04 10:37:59	1.7
@@ -1,4 +1,4 @@
-;; $Id: transactions.lisp,v 1.6 2006/08/03 18:37:50 alemmens Exp $
+;; $Id: transactions.lisp,v 1.7 2006/08/04 10:37:59 alemmens Exp $
 
 (in-package :rucksack)
 
@@ -315,12 +315,11 @@
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; WITH-TRANSACTION
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
+ 
 (defmacro with-transaction ((&rest args
                              &key (rucksack '(current-rucksack))
                              &allow-other-keys)
                             &body body)
-  (remf args :rucksack)
   (let ((committed (gensym "COMMITTED"))
         (transaction (gensym "TRANSACTION"))
         (result (gensym "RESULT")))
@@ -334,7 +333,8 @@
                      ;; Use a local variable for the transaction so that nothing
                      ;; can replace it from underneath us, and only then bind
                      ;; it to *TRANSACTION*. 
-                     (setf ,transaction (transaction-start :rucksack ,rucksack , at args))
+                     (setf ,transaction (transaction-start :rucksack ,rucksack
+                                                           ,@(sans args :rucksack)))
                      (let ((*transaction* ,transaction))
                        (with-simple-restart (abort "Abort ~S" ,transaction)
                          (setf ,result (progn , at body))