;;; gnus-range.el --- range and sequence functions for Gnus
-;; Copyright (C) 1996,97,98,99 Free Software Foundation, Inc.
+
+;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002
+;; Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Keywords: news
;;; List and range functions
+(defsubst gnus-range-normalize (range)
+ "Normalize RANGE.
+If RANGE is a single range, return (RANGE). Otherwise, return RANGE."
+ (if (listp (cdr-safe range)) range (list range)))
+
(defun gnus-last-element (list)
"Return last element of LIST."
(while (cdr list)
(setq list2 (cdr list2)))
list1))
+;;;###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
+(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.
If ALWAYS-LIST is non-nil, this function will always release a list of
out)))
(defun gnus-remove-from-range (range1 range2)
- "Return a range that has all articles from RANGE2 removed from
-RANGE1. The returned range is always a list. RANGE2 can also be a
-unsorted list of articles."
- (if (listp (cdr range2))
- (setq range2 (sort range2 (lambda (e1 e2)
- (< (if (consp e1) (car e1) e1)
- (if (consp e2) (car e2) e2))))))
+ "Return a range that has all articles from RANGE2 removed from RANGE1.
+The returned range is always a list. RANGE2 can also be a unsorted
+list of articles. RANGE1 is modified by side effects, RANGE2 is not
+modified."
(if (or (null range1) (null range2))
range1
- (let (out r1 r2 r1_min r1_max r2_min r2_max)
+ (let (out r1 r2 r1_min r1_max r2_min r2_max
+ (range2 (gnus-copy-sequence range2)))
(setq range1 (if (listp (cdr range1)) range1 (list range1))
- range2 (if (listp (cdr range2)) range2 (list range2))
+ range2 (sort (if (listp (cdr range2)) range2 (list range2))
+ (lambda (e1 e2)
+ (< (if (consp e1) (car e1) e1)
+ (if (consp e2) (car e2) e2))))
r1 (car range1)
r2 (car range2)
r1_min (if (consp r1) (car r1) r1)
r2_min (if (consp r2) (car r2) r2)
r2_max (if (consp r2) (cdr r2) r2))
(while (and range1 range2)
- (cond ((< r2_max r1_min) ; r2 < r1
+ (cond ((< r2_max r1_min) ; r2 < r1
(pop range2)
(setq r2 (car range2)
r2_min (if (consp r2) (car r2) r2)
(push r1_min out)
(push (cons r1_min (1- r2_min)) out))
(pop range2)
- (if (< r2_max r1_max) ; finished with r1?
+ (if (< r2_max r1_max) ; finished with r1?
(setq r1_min (1+ r2_max))
(pop range1)
(setq r1 (car range1)
(setq r1 (car range1)
r1_min (if (consp r1) (car r1) r1)
r1_max (if (consp r1) (cdr r1) r1)))
- ((< r1_max r2_min) ; r2 > r1
+ ((< r1_max r2_min) ; r2 > r1
(pop range1)
(if (eq r1_min r1_max)
(push r1_min out)
(push (cons r1_min r1_max) out))
(pop range1))
(while range1
- (push (pop range1) out))
+ (push (pop range1) out))
(nreverse out))))
(defun gnus-member-of-range (number ranges)
(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."
range item selector)
(while (or item1 item2)
(setq selector
- (cond
+ (cond
((null item1) nil)
((null item2) t)
((and (numberp item1) (numberp item2)) (< item1 item2))
(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))
(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)))
+
(provide 'gnus-range)
;;; gnus-range.el ends here
projects / gnus / blobdiff