Implement rtree-add.

[gnus] / lisp / rtree.el

diff --git a/lisp/rtree.el b/lisp/rtree.el
index 094a8fc..3836828 100644 (file)
--- a/lisp/rtree.el
+++ b/lisp/rtree.el
@@ -65,6 +65,12 @@
 (defmacro rtree-high (node)
   `(cdar ,node))
 
+(defmacro rtree-set-low (node number)
+  `(setcar (car ,node) ,number))
+
+(defmacro rtree-set-high (node number)
+  `(setcdr (car ,node) ,number))
+
 (defmacro rtree-left (node)
   `(cadr ,node))
 
@@ -98,35 +104,81 @@
     node))
 
 (defun rtree-memq (tree number)
-  (cond
-   ((and (>= number (rtree-low tree))
-        (<= number (rtree-high tree)))
-    t)
-   ((< number (rtree-low tree))
-    (and (rtree-left tree)
-        (rtree-memq (rtree-left tree) number)))
-   (t
-    (and (rtree-right tree)
-        (rtree-memq (rtree-right tree) number)))))
+  "Return non-nil if NUMBER is present in TREE."
+  (while (and tree
+             (not (and (>= number (rtree-low tree))
+                       (<= number (rtree-high tree)))))
+    (setq tree
+         (if (< number (rtree-low tree))
+             (rtree-left tree)
+           (rtree-right tree))))
+  tree)
+
+(defun rtree-add (tree number)
+  "Add NUMBER to TREE."
+  (while tree
+    (cond
+     ;; It's already present, so we don't have to do anything.
+     ((and (>= number (rtree-low tree))
+          (<= number (rtree-high tree)))
+      (setq tree nil))
+     ;; Extend the low range.
+     ((= number (1- (rtree-low tree)))
+      (rtree-set-low tree number)
+      ;; Check whether we need to merge this node with the child.
+      (when (and (rtree-left tree)
+                (= (rtree-high (rtree-left tree)) (1- number)))
+       ;; Extend the range to the low from the child.
+       (rtree-set-low tree (rtree-low (rtree-left tree)))
+       ;; The child can't have a right child, so just transplant the
+       ;; child's left tree to our left tree.
+       (rtree-set-left tree (rtree-left (rtree-left tree))))
+      (setq tree nil))
+     ;; Extend the high range.
+     ((= number (1+ (rtree-high tree)))
+      (rtree-set-high tree number)
+      ;; Check whether we need to merge this node with the child.
+      (when (and (rtree-right tree)
+                (= (rtree-low (rtree-right tree)) (1+ number)))
+       ;; Extend the range to the high from the child.
+       (rtree-set-high tree (rtree-high (rtree-right tree)))
+       ;; The child can't have a left child, so just transplant the
+       ;; child's left right to our right tree.
+       (rtree-set-right tree (rtree-right (rtree-right tree))))
+      (setq tree nil))
+     ((< number (rtree-low tree))
+      (if (rtree-left tree)
+         (setq tree (rtree-left tree))
+       (let ((new-node (rtree-make-node)))
+         (rtree-set-low new-node number)
+         (rtree-set-high new-node number)
+         (rtree-set-left tree new-node)
+         (setq tree nil))))
+     (t
+      (if (rtree-right tree)
+         (setq tree (rtree-right tree))
+       (let ((new-node (rtree-make-node)))
+         (rtree-set-low new-node number)
+         (rtree-set-high new-node number)
+         (rtree-set-right tree new-node)
+         (setq tree nil)))))))
 
 (defun rtree-extract (tree)
   "Convert TREE to range form."
-  (let ((stack (list tree))
-       result)
-    (while stack
-      (setq tree (pop stack))
-      (while (rtree-right tree)
-       (push tree stack)
-       (let ((a (rtree-right tree)))
-         (rtree-set-right tree nil)
-         (setq tree a)))
-      (push (if (= (rtree-low tree)
-                  (rtree-high tree))
-               (rtree-low tree)
-             (rtree-range tree))
-           result)
-      (when (rtree-left tree)
-       (push (rtree-left tree) stack)))
+  (let (stack result)
+    (while (or stack
+              tree)
+      (if tree
+         (progn
+           (push tree stack)
+           (setq tree (rtree-right tree)))
+       (setq tree (pop stack))
+       (push (if (= (rtree-low tree)
+                    (rtree-high tree))
+                 (rtree-low tree)
+               (rtree-range tree))
+             result)
+       (setq tree (rtree-left tree))))
     result))
 
 (provide 'rtree)