[rucksack-cvs] CVS rucksack

alemmens alemmens at common-lisp.net
Fri Aug 4 10:59:10 UTC 2006


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

Modified Files:
	p-btrees.lisp 
Log Message:
Provide restarts for BTREE-SEARCH (from Edi Weitz).


--- /project/rucksack/cvsroot/rucksack/p-btrees.lisp	2006/05/25 13:01:38	1.4
+++ /project/rucksack/cvsroot/rucksack/p-btrees.lisp	2006/08/04 10:59:10	1.5
@@ -1,4 +1,4 @@
-;; $Id: p-btrees.lisp,v 1.4 2006/05/25 13:01:38 alemmens Exp $
+;; $Id: p-btrees.lisp,v 1.5 2006/08/04 10:59:10 alemmens Exp $
 
 (in-package :rucksack)
 
@@ -200,17 +200,31 @@
 ERRORP option: if ERRORP is true, a btree-search-error is signalled;
 otherwise, DEFAULT-VALUE is returned."))
 
-
+ 
 (defmethod btree-search (btree key &key (errorp t) (default-value nil))
-  (if (slot-boundp btree 'root)
-      (node-search btree (slot-value btree 'root) key errorp default-value)
-    (not-found btree key errorp default-value)))
+  (restart-case 
+      (if (slot-boundp btree 'root)
+          (node-search btree (slot-value btree 'root) key errorp default-value)
+        (not-found btree key errorp default-value))
+    (use-value (value)
+      :report (lambda (stream)
+                (format stream "Specifiy a value to use this time for key ~S." key))
+      :interactive (lambda ()
+                     (format t "Enter a value for key ~S: " key)
+                     (multiple-value-list (eval (read))))
+      value)
+    (store-value (value)
+      :report (lambda (stream)
+                (format stream "Specify a value to set key ~S to." key))
+      :interactive (lambda ()
+                     (format t "Enter a value for key ~S: " key)
+                     (multiple-value-list (eval (read))))
+      (btree-insert btree key value))))
 
 
 (defun not-found (btree key errorp default-value)
   (if (btree-unique-keys-p btree)
       (if errorp
-          ;; DO: Provide restarts here (USE-VALUE, STORE-VALUE, ...).
           (error 'btree-search-error :btree btree :key key)
         default-value)
     '()))




More information about the rucksack-cvs mailing list