X-Git-Url: http://cgit.sxemacs.org/?a=blobdiff_plain;f=lisp%2Frtree.el;h=04079b1ba8b812b1c71a5bd132d24663710f3260;hb=91b06d4b174a8a2e578595e95314234e03bdc9f4;hp=b72f923578cbd4eb2eaf93c9fc86d005ec838ca9;hpb=ec9c24e6936a0ac6bcf1e8bac7538a1daf0229b5;p=gnus

diff --git a/lisp/rtree.el b/lisp/rtree.el
index b72f92357..04079b1ba 100644
--- a/lisp/rtree.el
+++ b/lisp/rtree.el
@@ -1,24 +1,23 @@
 ;;; rtree.el --- functions for manipulating range trees
+
 ;; Copyright (C) 2010 Free Software Foundation, Inc.
 
 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
 
 ;; This file is part of GNU Emacs.
 
-;; GNU Emacs is free software; you can redistribute it and/or modify
+;; GNU Emacs is free software: you can redistribute it and/or modify
 ;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 3, or (at your option)
-;; any later version.
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
 
 ;; GNU Emacs is distributed in the hope that it will be useful,
 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.	 See the
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 ;; GNU General Public License for more details.
 
 ;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING.  If not, write to the
-;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
+;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
 
 ;;; Commentary:
 
@@ -65,6 +64,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,16 +103,148 @@
     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))
+     ((< number (rtree-low tree))
+      (cond
+       ;; 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))
+       ;; Descend further to the left.
+       ((rtree-left tree)
+	(setq tree (rtree-left tree)))
+       ;; Add a new node.
+       (t
+	(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
+      (cond
+       ;; 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))
+       ;; Descend further to the right.
+       ((rtree-right tree)
+	(setq tree (rtree-right tree)))
+       ;; Add a new node.
+       (t
+	(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-delq (tree number)
+  "Remove NUMBER from TREE destructively.  Returns the new tree."
+  (let ((result tree)
+	prev)
+    (while tree
+      (cond
+       ((< number (rtree-low tree))
+	(setq prev tree
+	      tree (rtree-left tree)))
+       ((> number (rtree-high tree))
+	(setq prev tree
+	      tree (rtree-right tree)))
+       ;; The number is in this node.
+       (t
+	(cond
+	 ;; The only entry; delete the node.
+	 ((= (rtree-low tree) (rtree-high tree))
+	  (cond
+	   ;; Two children.  Replace with successor value.
+	   ((and (rtree-left tree) (rtree-right tree))
+	    (let ((parent tree)
+		  (successor (rtree-right tree)))
+	      (while (rtree-left successor)
+		(setq parent successor
+		      successor (rtree-left successor)))
+	      ;; We now have the leftmost child of our right child.
+	      (rtree-set-range tree (rtree-range successor))
+	      ;; Transplant the child (if any) to the parent.
+	      (rtree-set-left parent (rtree-right successor))))
+	   (t
+	    (let ((rest (or (rtree-left tree)
+			    (rtree-right tree))))
+	      ;; One or zero children.  Remove the node.
+	      (cond
+	       ((null prev)
+		(setq result rest))
+	       ((eq (rtree-left prev) tree)
+		(rtree-set-left prev rest))
+	       (t
+		(rtree-set-right prev rest)))))))
+	 ;; The lowest in the range; just adjust.
+	 ((= number (rtree-low tree))
+	  (rtree-set-low tree (1+ number)))
+	 ;; The highest in the range; just adjust.
+	 ((= number (rtree-high tree))
+	  (rtree-set-high tree (1- number)))
+	 ;; We have to split this range.
+	 (t
+	  (let ((new-node (rtree-make-node)))
+	    (rtree-set-low new-node (rtree-low tree))
+	    (rtree-set-high new-node (1- number))
+	    (rtree-set-low tree (1+ number))
+	    (cond
+	     ;; Two children; insert the new node as the predecessor
+	     ;; node.
+	     ((and (rtree-left tree) (rtree-right tree))
+	      (let ((predecessor (rtree-left tree)))
+		(while (rtree-right predecessor)
+		  (setq predecessor (rtree-right predecessor)))
+		(rtree-set-right predecessor new-node)))
+	     ((rtree-left tree)
+	      (rtree-set-right new-node tree)
+	      (rtree-set-left new-node (rtree-left tree))
+	      (rtree-set-left tree nil)
+	      (cond
+	       ((null prev)
+		(setq result new-node))
+	       ((eq (rtree-left prev) tree)
+		(rtree-set-left prev new-node))
+	       (t
+		(rtree-set-right prev new-node))))
+	     (t
+	      (rtree-set-left tree new-node))))))
+	(setq tree nil))))
+    result))
 
 (defun rtree-extract (tree)
   "Convert TREE to range form."
@@ -127,6 +264,15 @@
 	(setq tree (rtree-left tree))))
     result))
 
+(defun rtree-length (tree)
+  "Return the number of numbers stored in TREE."
+  (if (null tree)
+      0
+    (+ (rtree-length (rtree-left tree))
+       (1+ (- (rtree-high tree)
+	      (rtree-low tree)))
+       (rtree-length (rtree-right tree)))))
+
 (provide 'rtree)
 
 ;;; rtree.el ends here