;;; gnus-range.el --- range and sequence functions for Gnus
-;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001
+;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2004
;; Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
(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."
(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 <."
(setq list2 (cdr list2)))))
(nconc (nreverse out) (or list1 list2)))))
+;;;###autoload
(defun gnus-intersection (list1 list2)
(let ((result nil))
(while list2
(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))
(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) 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)
+
+;;;###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)
(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))
(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
(when (and ranges
(if (numberp (car ranges))
(= (car ranges) number)
- (< number (cdar ranges))))
+ ;; (caar ranges) <= number <= (cdar ranges)
+ (>= number (caar ranges))))
(push number result)))
(nreverse result)))
-(defun gnus-inverse-list-range-intersection (list ranges)
+(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
(when (or (not ranges)
(if (numberp (car ranges))
(not (= (car ranges) number))
- (not (<= number (cdar ranges)))))
+ ;; 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."
(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."
+ (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