*** e:/src/lisp/lib/rucksack-orig/p-btrees.lisp	Sun Aug 12 13:01:14 2007
--- e:/src/lisp/lib/rucksack/p-btrees.lisp	Mon Dec 17 15:47:17 2007
***************
*** 868,883 ****
        (ecase if-does-not-exist
          (:ignore (return-from leaf-delete-key))
          (:error (error 'btree-search-error :btree btree :key key))))
! 
!     (let* ((position (key-position key leaf))
             (length (btree-node-index-count leaf))
             (was-biggest-key-p (= position (1- length))))
!       
!       (remove-key leaf (binding-key binding))
!       
        (unless (node-full-enough-p btree leaf)
          (enlarge-node btree leaf parent-stack))
-       
        (when was-biggest-key-p
          (unless (= 0 (btree-node-index-count leaf))
            (update-parents-for-deleted-key btree parent-stack key (biggest-key leaf)))))))
--- 868,879 ----
        (ecase if-does-not-exist
          (:ignore (return-from leaf-delete-key))
          (:error (error 'btree-search-error :btree btree :key key))))
!     (let* ((position (key-position key leaf :test (btree-key= btree)))
             (length (btree-node-index-count leaf))
             (was-biggest-key-p (= position (1- length))))
!       (remove-key leaf (binding-key binding) :test (btree-key= btree))
        (unless (node-full-enough-p btree leaf)
          (enlarge-node btree leaf parent-stack))
        (when was-biggest-key-p
          (unless (= 0 (btree-node-index-count leaf))
            (update-parents-for-deleted-key btree parent-stack key (biggest-key leaf)))))))
***************
*** 915,921 ****
    (when parent-stack
      (let ((node (first parent-stack)))
        (when node
!         (let ((position (key-position old-key node)))
            (when position
              (setf (binding-key (node-binding node position))
                    new-key)
--- 911,917 ----
    (when parent-stack
      (let ((node (first parent-stack)))
        (when node
!         (let ((position (key-position old-key node :test (btree-key= btree))))
            (when position
              (setf (binding-key (node-binding node position))
                    new-key)
***************
*** 978,984 ****
                 :start1 left-length
                 :start2 0 :end2 right-length)
      ;; Remove key which pointed to LEFT-NODE.
!     (remove-key parent (binding-key left-binding))
      ;; Make binding which pointed to RIGHT-NODE point to LEFT-NODE.
      (setf (binding-value right-binding) left-node)
      ;; Set new length of LEFT-NODE.
--- 974,980 ----
                 :start1 left-length
                 :start2 0 :end2 right-length)
      ;; Remove key which pointed to LEFT-NODE.
!     (remove-key parent (binding-key left-binding) :test (btree-key= btree))
      ;; Make binding which pointed to RIGHT-NODE point to LEFT-NODE.
      (setf (binding-value right-binding) left-node)
      ;; Set new length of LEFT-NODE.
***************
*** 1002,1009 ****
          do (setf (node-binding node i) nil))
    (setf (btree-node-index-count node) new-length))
  
! (defun remove-key (node key)
!   (let ((position (key-position key node))
          (length (btree-node-index-count node)))
      (unless (>= position (1- length))
        ;; Move bindings to the left.
--- 998,1005 ----
          do (setf (node-binding node i) nil))
    (setf (btree-node-index-count node) new-length))
  
! (defun remove-key (node key &key test)
!   (let ((position (key-position key node :test test))
          (length (btree-node-index-count node)))
      (unless (>= position (1- length))
        ;; Move bindings to the left.
***************
*** 1013,1021 ****
                     :start2 (1+ position) :end2 length)))
      (shorten node (1- length))))
      
! (defun key-position (key node)
    (p-position key (btree-node-index node)
                :key #'binding-key
                :end (btree-node-index-count node)))
  
  (defun node-full-enough-p (btree node)
--- 1009,1018 ----
                     :start2 (1+ position) :end2 length)))
      (shorten node (1- length))))
      
! (defun key-position (key node &key test)
    (p-position key (btree-node-index node)
                :key #'binding-key
+ 	      :test test
                :end (btree-node-index-count node)))
  
  (defun node-full-enough-p (btree node)
