;;; gnus-range.el --- range and sequence functions for Gnus
-;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002
-;; Free Software Foundation, Inc.
+;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
+;; 2005, 2006 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Keywords: news
;; 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:
(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.
(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)
+ (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)
(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))
(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