Rewrite gnus-range-add

Rewrite gnus-range-add

[Shenghuo ZHU]

gnus-agent-expire caused X crash!

When gnus-agent-expire calls gnus-range-add, which uncompresses an
extremely large range, such as ("misc.jobs.offered" 3 (1 . 10809366)),
memory is used up.

A patch is attached.

Wed Feb 10 01:03:43 1999  Shenghuo ZHU  <zsh@cs.rochester.edu>

	* gnus-range.el (gnus-range-add): Rewrite.

-- 
Shenghuo


--- gnus-range.el	1999/02/10 06:02:05	1.1
+++ gnus-range.el	1999/02/10 06:02:39
@@ -326,19 +326,59 @@
     sublistp))
 
 (defun gnus-range-add (range1 range2)
-  "Add RANGE2 to RANGE1 destructively."
-  (cond
-   ;; If either are nil, then the job is quite easy.
-   ((or (null range1) (null range2))
-    (or range1 range2))
-   (t
-    ;; I don't like thinking.
-    (gnus-compress-sequence
-     (sort
-      (nconc
-       (gnus-uncompress-range range1)
-       (gnus-uncompress-range range2))
-      '<)))))
+  "Add RANGE2 to RANGE1 (nondestructively)."
+  (unless (listp (cdr range1))
+    (setq range1 (list range1)))
+  (unless (listp (cdr range2))
+    (setq range2 (list range2)))
+  (let ((item1 (pop range1))
+	(item2 (pop range2))
+	range item selector)
+    (while (or item1 item2)
+      (setq selector
+	    (cond 
+	     ((null item1) nil)
+	     ((null item2) t)
+	     ((and (numberp item1) (numberp item2)) (< item1 item2))
+	     ((numberp item1) (< item1 (car item2)))
+	     ((numberp item2) (< (car item1) item2))
+	     (t (< (car item1) (car item2)))))
+      (setq item
+	    (or
+	     (let ((tmp1 item) (tmp2 (if selector item1 item2)))
+	       (cond 
+		((null tmp1) tmp2)
+		((null tmp2) tmp1)
+		((and (numberp tmp1) (numberp tmp2))
+		 (cond 
+		  ((eq tmp1 tmp2) tmp1)
+		  ((eq (1+ tmp1) tmp2) (cons tmp1 tmp2))
+		  ((eq (1+ tmp2) tmp1) (cons tmp2 tmp1))
+		  (t nil)))
+		((numberp tmp1)
+		 (cond 
+		  ((and (>= tmp1 (car tmp2)) (<= tmp1 (cdr tmp2))) tmp2)
+		  ((eq (1+ tmp1) (car tmp2)) (cons tmp1 (cdr tmp2)))
+		  ((eq (1- tmp1) (cdr tmp2)) (cons (car tmp2) tmp1))
+		  (t nil)))
+		((numberp tmp2)
+		 (cond 
+		  ((and (>= tmp2 (car tmp1)) (<= tmp2 (cdr tmp1))) tmp1)
+		  ((eq (1+ tmp2) (car tmp1)) (cons tmp2 (cdr tmp1)))
+		  ((eq (1- tmp2) (cdr tmp1)) (cons (car tmp1) tmp2))
+		  (t nil)))
+		((< (1+ (cdr tmp1)) (car tmp2)) nil)
+		((< (1+ (cdr tmp2)) (car tmp1)) nil)
+		(t (cons (min (car tmp1) (car tmp2)) 
+			 (max (cdr tmp1) (cdr tmp2))))))
+	     (progn
+	       (if item (push item range))
+	       (if selector item1 item2))))
+      (if selector
+	  (setq item1 (pop range1))
+	(setq item2 (pop range2))))
+    (if item (push item range))
+    (reverse range)))
 
 (provide 'gnus-range)