emacs-diffs
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[Emacs-diffs] Changes to emacs/lisp/gnus/gnus-range.el


From: Miles Bader
Subject: [Emacs-diffs] Changes to emacs/lisp/gnus/gnus-range.el
Date: Sat, 04 Sep 2004 09:52:34 -0400

Index: emacs/lisp/gnus/gnus-range.el
diff -c emacs/lisp/gnus/gnus-range.el:1.7 emacs/lisp/gnus/gnus-range.el:1.8
*** emacs/lisp/gnus/gnus-range.el:1.7   Mon Sep  1 15:45:24 2003
--- emacs/lisp/gnus/gnus-range.el       Sat Sep  4 13:13:43 2004
***************
*** 1,6 ****
  ;;; gnus-range.el --- range and sequence functions for Gnus
  
! ;; Copyright (C) 1996, 1997, 1998, 1999, 2000 Free Software Foundation, Inc.
  
  ;; Author: Lars Magne Ingebrigtsen <address@hidden>
  ;; Keywords: news
--- 1,7 ----
  ;;; gnus-range.el --- range and sequence functions for Gnus
  
! ;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002
! ;;        Free Software Foundation, Inc.
  
  ;; Author: Lars Magne Ingebrigtsen <address@hidden>
  ;; Keywords: news
***************
*** 30,35 ****
--- 31,41 ----
  
  ;;; 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)
***************
*** 55,60 ****
--- 61,145 ----
        (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 <."
***************
*** 73,78 ****
--- 158,164 ----
               (setq list2 (cdr list2)))))
        (nconc (nreverse out) (or list1 list2)))))
  
+ ;;;###autoload
  (defun gnus-intersection (list1 list2)
    (let ((result nil))
      (while list2
***************
*** 81,88 ****
        (setq list2 (cdr list2)))
      result))
  
  (defun gnus-sorted-intersection (list1 list2)
!   ;; LIST1 and LIST2 have to be sorted over <.
    (let (out)
      (while (and list1 list2)
        (cond ((= (car list1) (car list2))
--- 167,176 ----
        (setq list2 (cdr list2)))
      result))
  
+ ;;;###autoload
  (defun gnus-sorted-intersection (list1 list2)
!   "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))
***************
*** 95,103 ****
             (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.
    (let* ((top (cons nil list1))
         (prev top))
      (while (and list1 list2)
--- 183,195 ----
             (setq list2 (cdr list2)))))
      (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)
***************
*** 113,118 ****
--- 205,259 ----
      (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
***************
*** 319,327 ****
        (setq ranges (cdr ranges)))
        (not not-stop))))
  
  (defun gnus-range-length (range)
    "Return the length RANGE would have if uncompressed."
!   (length (gnus-uncompress-range range)))
  
  (defun gnus-sublist-p (list sublist)
    "Test whether all elements in SUBLIST are members of LIST."
--- 460,517 ----
        (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."
!   (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."
***************
*** 387,392 ****
--- 577,594 ----
      (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)
  
  ;;; arch-tag: 4780bdd8-5a15-4aff-be28-18727895b6ad




reply via email to

[Prev in Thread] Current Thread [Next in Thread]