diff options
Diffstat (limited to 'lisp/gnus/gnus-range.el')
-rw-r--r-- | lisp/gnus/gnus-range.el | 67 |
1 files changed, 66 insertions, 1 deletions
diff --git a/lisp/gnus/gnus-range.el b/lisp/gnus/gnus-range.el index 56a1b569418..d2442c63a42 100644 --- a/lisp/gnus/gnus-range.el +++ b/lisp/gnus/gnus-range.el @@ -1,6 +1,6 @@ ;;; gnus-range.el --- range and sequence functions for Gnus -;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002 +;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2004 ;; Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org> @@ -184,6 +184,58 @@ LIST1 and LIST2 have to be sorted over <." (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) + (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 @@ -589,6 +641,19 @@ 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." + (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 |