X-Git-Url: https://cgit.sxemacs.org/?a=blobdiff_plain;f=lisp%2Fgnus-range.el;h=ffe47c16d9547eb5512f264d963a2ae4d40f7317;hb=cb974d1ba2e1ca8772a023a6073434ca2854aea5;hp=fc151a2ea7bb5339219c397debf51b7b23f7420c;hpb=0e7b41dbcc71238aa372a03f8efec61f70cbc5d1;p=gnus

diff --git a/lisp/gnus-range.el b/lisp/gnus-range.el
index fc151a2ea..ffe47c16d 100644
--- a/lisp/gnus-range.el
+++ b/lisp/gnus-range.el
@@ -183,6 +183,43 @@ LIST1 and LIST2 have to be sorted over <."
 	     (setq list2 (cdr list2)))))
     (nreverse out)))
 
+;;;###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) min1 (prog1 (cdr min1) (setq min1 (car min1)))))
+         (min2 (car range2))
+         (max2 (if (numberp min2) 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))))
+    (nreverse out)))
+
 ;;;###autoload
 (defalias 'gnus-set-sorted-intersection 'gnus-sorted-nintersection)
 
@@ -589,6 +626,18 @@ LIST is a sorted list."
       (setcdr prev (cons num list)))
     (cdr top)))
 
+(defun gnus-range-map (func range)
+  "Apply FUNC to each value contained by 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)
 
 ;;; gnus-range.el ends here