X-Git-Url: http://cgit.sxemacs.org/?p=gnus;a=blobdiff_plain;f=lisp%2Fgnus-range.el;h=454712a7a97d57e78352cf109590a81768aefe56;hp=8e3c0972f179941bef80cf24b67994b7d880c078;hb=125d88b46ad2efa065f06d5dac37a245b488985a;hpb=fb3026c3571f61a9878777fa53b5fd2ad26ede2f diff --git a/lisp/gnus-range.el b/lisp/gnus-range.el index 8e3c0972f..454712a7a 100644 --- a/lisp/gnus-range.el +++ b/lisp/gnus-range.el @@ -1,6 +1,6 @@ ;;; 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 @@ -34,7 +34,7 @@ (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." @@ -61,6 +61,85 @@ If RANGE is a single range, return (RANGE). Otherwise, return RANGE." (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 <." @@ -79,6 +158,7 @@ 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 @@ -87,8 +167,10 @@ Both lists have to be sorted over <." (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)) @@ -101,9 +183,65 @@ Both lists have to be sorted over <." (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) + (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 +(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) @@ -119,8 +257,57 @@ Both lists have to be sorted over <." (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)) @@ -328,6 +515,7 @@ modified." (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 @@ -338,13 +526,17 @@ LIST is a sorted list." (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 @@ -355,13 +547,23 @@ LIST is a sorted list." (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." @@ -427,6 +629,32 @@ LIST is a sorted 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." + (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