[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Emacs-diffs] Changes to emacs/lisp/gnus/gnus-range.el [emacs-unicode-2]
From: |
Miles Bader |
Subject: |
[Emacs-diffs] Changes to emacs/lisp/gnus/gnus-range.el [emacs-unicode-2] |
Date: |
Thu, 09 Sep 2004 08:06:38 -0400 |
Index: emacs/lisp/gnus/gnus-range.el
diff -c emacs/lisp/gnus/gnus-range.el:1.6.6.1
emacs/lisp/gnus/gnus-range.el:1.6.6.2
*** emacs/lisp/gnus/gnus-range.el:1.6.6.1 Fri Mar 12 00:02:57 2004
--- emacs/lisp/gnus/gnus-range.el Thu Sep 9 09:36:25 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
[Prev in Thread] |
Current Thread |
[Next in Thread] |
- [Emacs-diffs] Changes to emacs/lisp/gnus/gnus-range.el [emacs-unicode-2],
Miles Bader <=