X-Git-Url: http://cgit.sxemacs.org/?p=gnus;a=blobdiff_plain;f=lisp%2Fgnus-range.el;h=a3942bc83f52a9c2b4a237687489a1544ef2b418;hp=45855d90c9e199b9777f7f18ce2730884d5356c3;hb=915c1bceb6e7e1ea69eac0485892763825b2c57c;hpb=c4eed2df44503a5c9f5372b45d2dc0a8057e6a37

diff --git a/lisp/gnus-range.el b/lisp/gnus-range.el
index 45855d90c..a3942bc83 100644
--- a/lisp/gnus-range.el
+++ b/lisp/gnus-range.el
@@ -1,6 +1,7 @@
 ;;; gnus-range.el --- range and sequence functions for Gnus
 
-;; Copyright (C) 1996, 1997, 1998, 1999, 2000 Free Software Foundation, Inc.
+;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
+;;   2005 Free Software Foundation, Inc.
 
 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
 ;; Keywords: news
@@ -19,8 +20,8 @@
 
 ;; 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., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
+;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
 
 ;;; Commentary:
 
@@ -33,7 +34,7 @@
 (defsubst gnus-range-normalize (range)
   "Normalize RANGE.
 If RANGE is a single range, return (RANGE). Otherwise, return RANGE."
-  (if (listp (cdr range)) (list range) range))
+  (if (listp (cdr-safe range)) range (list range)))
 
 (defun gnus-last-element (list)
   "Return last element of LIST."
@@ -60,6 +61,85 @@ If RANGE is a single range, return (RANGE). Otherwise, return RANGE."
       (setq list2 (cdr list2)))
     list1))
 
+(defun gnus-range-difference (range1 range2)
+  "Return the range of elements in RANGE1 that do not appear in RANGE2.
+Both ranges must be in ascending order."
+  (setq range1 (gnus-range-normalize range1))
+  (setq range2 (gnus-range-normalize range2))
+  (let* ((new-range (cons nil (copy-sequence range1)))
+         (r new-range)
+         (safe t))
+    (while (cdr r)
+      (let* ((r1 (cadr r))
+             (r2 (car range2))
+             (min1 (if (numberp r1) r1 (car r1)))
+             (max1 (if (numberp r1) r1 (cdr r1)))
+             (min2 (if (numberp r2) r2 (car r2)))
+             (max2 (if (numberp r2) r2 (cdr r2))))
+
+        (cond ((> min1 max1)
+               ;; Invalid range: may result from overlap condition (below)
+               ;; remove Invalid range
+               (setcdr r (cddr r)))
+              ((and (= min1 max1)
+                    (listp r1))
+               ;; Inefficient representation: may result from overlap condition (below)
+               (setcar (cdr r) min1))
+              ((not min2)
+               ;; All done with range2
+               (setq r nil))
+              ((< max1 min2)
+               ;; No overlap: range1 preceeds range2
+               (pop r))
+              ((< max2 min1)
+               ;; No overlap: range2 preceeds range1
+               (pop range2))
+              ((and (<= min2 min1) (<= max1 max2))
+               ;; Complete overlap: range1 removed
+               (setcdr r (cddr r)))
+              (t
+               (setcdr r (nconc (list (cons min1 (1- min2)) (cons (1+ max2) max1)) (cddr r)))))))
+    (cdr new-range)))
+
+
+
+;;;###autoload
+(defun gnus-sorted-difference (list1 list2)
+  "Return a list of elements of LIST1 that do not appear in LIST2.
+Both lists have to be sorted over <.
+The tail of LIST1 is not copied."
+  (let (out)
+    (while (and list1 list2)
+      (cond ((= (car list1) (car list2))
+	     (setq list1 (cdr list1)
+		   list2 (cdr list2)))
+	    ((< (car list1) (car list2))
+	     (setq out (cons (car list1) out))
+	     (setq list1 (cdr list1)))
+	    (t
+	     (setq list2 (cdr list2)))))
+    (nconc (nreverse out) list1)))
+
+;;;###autoload
+(defun gnus-sorted-ndifference (list1 list2)
+  "Return a list of elements of LIST1 that do not appear in LIST2.
+Both lists have to be sorted over <.
+LIST1 is modified."
+  (let* ((top (cons nil list1))
+	 (prev top))
+    (while (and list1 list2)
+      (cond ((= (car list1) (car list2))
+	     (setcdr prev (cdr list1))
+	     (setq list1 (cdr list1)
+		   list2 (cdr list2)))
+	    ((< (car list1) (car list2))
+	     (setq prev list1
+		   list1 (cdr list1)))
+	    (t
+	     (setq list2 (cdr list2)))))
+    (cdr top)))
+
+;;;###autoload
 (defun gnus-sorted-complement (list1 list2)
   "Return a list of elements that are in LIST1 or LIST2 but not both.
 Both lists have to be sorted over <."
@@ -78,6 +158,7 @@ Both lists have to be sorted over <."
 	       (setq list2 (cdr list2)))))
       (nconc (nreverse out) (or list1 list2)))))
 
+;;;###autoload
 (defun gnus-intersection (list1 list2)
   (let ((result nil))
     (while list2
@@ -86,8 +167,10 @@ Both lists have to be sorted over <."
       (setq list2 (cdr list2)))
     result))
 
+;;;###autoload
 (defun gnus-sorted-intersection (list1 list2)
-  ;; LIST1 and LIST2 have to be sorted over <.
+  "Return intersection of LIST1 and LIST2.
+LIST1 and LIST2 have to be sorted over <."
   (let (out)
     (while (and list1 list2)
       (cond ((= (car list1) (car list2))
@@ -100,9 +183,65 @@ Both lists have to be sorted over <."
 	     (setq list2 (cdr list2)))))
     (nreverse out)))
 
-(defun gnus-set-sorted-intersection (list1 list2)
-  ;; LIST1 and LIST2 have to be sorted over <.
-  ;; This function modifies LIST1.
+;;;###autoload
+(defun gnus-sorted-range-intersection (range1 range2)
+  "Return intersection of RANGE1 and RANGE2.
+RANGE1 and RANGE2 have to be sorted over <."
+  (let* (out
+         (min1 (car range1))
+         (max1 (if (numberp min1) 
+                   (if (numberp (cdr range1))
+                       (prog1 (cdr range1)
+                         (setq range1 nil)) min1)
+                 (prog1 (cdr min1)
+                   (setq min1 (car min1)))))
+         (min2 (car range2))
+         (max2 (if (numberp min2)
+                   (if (numberp (cdr range2))
+                       (prog1 (cdr range2) 
+                         (setq range2 nil)) min2) 
+                 (prog1 (cdr min2)
+                   (setq min2 (car min2))))))
+    (setq range1 (cdr range1)
+          range2 (cdr range2))
+    (while (and min1 min2)
+      (cond ((< max1 min2)              ; range1 preceeds range2
+             (setq range1 (cdr range1)
+                   min1 nil))
+            ((< max2 min1)              ; range2 preceeds range1
+             (setq range2 (cdr range2)
+                   min2 nil))
+            (t                     ; some sort of overlap is occurring
+             (let ((min (max min1 min2))
+                   (max (min max1 max2)))
+               (setq out (if (= min max)
+                             (cons min out)
+                           (cons (cons min max) out))))
+             (if (< max1 max2)          ; range1 ends before range2
+                 (setq min1 nil)        ; incr range1
+               (setq min2 nil))))       ; incr range2
+      (unless min1
+        (setq min1 (car range1)
+              max1 (if (numberp min1) min1 (prog1 (cdr min1) (setq min1 (car min1))))
+              range1 (cdr range1)))
+      (unless min2
+        (setq min2 (car range2)
+              max2 (if (numberp min2) min2 (prog1 (cdr min2) (setq min2 (car min2))))
+              range2 (cdr range2))))
+    (cond ((cdr out)
+        (nreverse out))
+          ((numberp (car out))
+           out)
+          (t
+           (car out)))))
+
+;;;###autoload
+(defalias 'gnus-set-sorted-intersection 'gnus-sorted-nintersection)
+
+;;;###autoload
+(defun gnus-sorted-nintersection (list1 list2)
+  "Return intersection of LIST1 and LIST2 by modifying cdr pointers of LIST1.
+LIST1 and LIST2 have to be sorted over <."
   (let* ((top (cons nil list1))
 	 (prev top))
     (while (and list1 list2)
@@ -118,8 +257,57 @@ Both lists have to be sorted over <."
     (setcdr prev nil)
     (cdr top)))
 
+;;;###autoload
+(defun gnus-sorted-union (list1 list2)
+  "Return union of LIST1 and LIST2.
+LIST1 and LIST2 have to be sorted over <."
+  (let (out)
+    (while (and list1 list2)
+      (cond ((= (car list1) (car list2))
+	     (setq out (cons (car list1) out)
+		   list1 (cdr list1)
+		   list2 (cdr list2)))
+	    ((< (car list1) (car list2))
+	     (setq out (cons (car list1) out)
+		   list1 (cdr list1)))
+	    (t
+	     (setq out (cons (car list2) out)
+		   list2 (cdr list2)))))
+    (while list1
+      (setq out (cons (car list1) out)
+	    list1 (cdr list1)))
+    (while list2
+      (setq out (cons (car list2) out)
+	    list2 (cdr list2)))
+    (nreverse out)))
+
+;;;###autoload
+(defun gnus-sorted-nunion (list1 list2)
+  "Return union of LIST1 and LIST2 by modifying cdr pointers of LIST1.
+LIST1 and LIST2 have to be sorted over <."
+  (let* ((top (cons nil list1))
+	 (prev top))
+    (while (and list1 list2)
+      (cond ((= (car list1) (car list2))
+	     (setq prev list1
+		   list1 (cdr list1)
+		   list2 (cdr list2)))
+	    ((< (car list1) (car list2))
+	     (setq prev list1
+		   list1 (cdr list1)))
+	    (t
+	     (setcdr prev (list (car list2)))
+	     (setq prev (cdr prev)
+		   list2 (cdr list2))
+	     (setcdr prev list1))))
+    (while list2
+      (setcdr prev (list (car list2)))
+      (setq prev (cdr prev)
+	    list2 (cdr list2)))
+    (cdr top)))
+
 (defun gnus-compress-sequence (numbers &optional always-list)
-  "Convert list of numbers to a list of ranges or a single range.
+  "Convert sorted list of numbers to a list of ranges or a single range.
 If ALWAYS-LIST is non-nil, this function will always release a list of
 ranges."
   (let* ((first (car numbers))
@@ -324,9 +512,58 @@ modified."
 	(setq ranges (cdr ranges)))
       (not not-stop))))
 
+(defun gnus-list-range-intersection (list ranges)
+  "Return a list of numbers in LIST that are members of RANGES.
+LIST is a sorted list."
+  (setq ranges (gnus-range-normalize ranges))
+  (let (number result)
+    (while (setq number (pop list))
+      (while (and ranges
+		  (if (numberp (car ranges))
+		      (< (car ranges) number)
+		    (< (cdar ranges) number)))
+	(setq ranges (cdr ranges)))
+      (when (and ranges
+		 (if (numberp (car ranges))
+		      (= (car ranges) number)
+		   ;; (caar ranges) <= number <= (cdar ranges)
+		   (>= number (caar ranges))))
+	(push number result)))
+    (nreverse result)))
+
+(defalias 'gnus-inverse-list-range-intersection 'gnus-list-range-difference)
+
+(defun gnus-list-range-difference (list ranges)
+  "Return a list of numbers in LIST that are not members of RANGES.
+LIST is a sorted list."
+  (setq ranges (gnus-range-normalize ranges))
+  (let (number result)
+    (while (setq number (pop list))
+      (while (and ranges
+		  (if (numberp (car ranges))
+		      (< (car ranges) number)
+		    (< (cdar ranges) number)))
+	(setq ranges (cdr ranges)))
+      (when (or (not ranges)
+		(if (numberp (car ranges))
+		    (not (= (car ranges) number))
+		  ;; not ((caar ranges) <= number <= (cdar ranges))
+		  (< number (caar ranges))))
+	(push number result)))
+    (nreverse result)))
+
 (defun gnus-range-length (range)
   "Return the length RANGE would have if uncompressed."
-  (length (gnus-uncompress-range range)))
+  (cond
+   ((null range)
+    0)
+   ((not (listp (cdr range)))
+    (- (cdr range) (car range) -1))
+   (t
+    (let ((sum 0))
+      (dolist (x range sum)
+	(setq sum
+	      (+ sum (if (consp x) (- (cdr x) (car x) -1) 1))))))))
 
 (defun gnus-sublist-p (list sublist)
   "Test whether all elements in SUBLIST are members of LIST."
@@ -348,7 +585,7 @@ modified."
 	range item selector)
     (while (or item1 item2)
       (setq selector
-	    (cond 
+	    (cond
 	     ((null item1) nil)
 	     ((null item2) t)
 	     ((and (numberp item1) (numberp item2)) (< item1 item2))
@@ -358,30 +595,30 @@ modified."
       (setq item
 	    (or
 	     (let ((tmp1 item) (tmp2 (if selector item1 item2)))
-	       (cond 
+	       (cond
 		((null tmp1) tmp2)
 		((null tmp2) tmp1)
 		((and (numberp tmp1) (numberp tmp2))
-		 (cond 
+		 (cond
 		  ((eq tmp1 tmp2) tmp1)
 		  ((eq (1+ tmp1) tmp2) (cons tmp1 tmp2))
 		  ((eq (1+ tmp2) tmp1) (cons tmp2 tmp1))
 		  (t nil)))
 		((numberp tmp1)
-		 (cond 
+		 (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 
+		 (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)) 
+		(t (cons (min (car tmp1) (car tmp2))
 			 (max (cdr tmp1) (cdr tmp2))))))
 	     (progn
 	       (if item (push item range))
@@ -392,6 +629,32 @@ modified."
     (if item (push item range))
     (reverse range)))
 
+;;;###autoload
+(defun gnus-add-to-sorted-list (list num)
+  "Add NUM into sorted LIST by side effect."
+  (let* ((top (cons nil list))
+	 (prev top))
+    (while (and list (< (car list) num))
+      (setq prev list
+	    list (cdr list)))
+    (unless (eq (car list) num)
+      (setcdr prev (cons num list)))
+    (cdr top)))
+
+(defun gnus-range-map (func range)
+  "Apply FUNC to each value contained by RANGE."
+  (setq range (gnus-range-normalize range))
+  (while range
+    (let ((span (pop range)))
+      (if (numberp span)
+          (funcall func span)
+        (let ((first (car span))
+              (last (cdr span)))
+          (while (<= first last)
+            (funcall func first)
+            (setq first (1+ first))))))))
+
 (provide 'gnus-range)
 
+;;; arch-tag: 4780bdd8-5a15-4aff-be28-18727895b6ad
 ;;; gnus-range.el ends here