[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
master 39d4e1ca21 1/2: Move the Gnus range functions to a new range.el f
|
From: |
Lars Ingebrigtsen |
|
Subject: |
master 39d4e1ca21 1/2: Move the Gnus range functions to a new range.el file |
|
Date: |
Mon, 17 Jan 2022 09:48:01 -0500 (EST) |
branch: master
commit 39d4e1ca21f3270d4835d5efa8862efc618c4cd9
Author: Lars Ingebrigtsen <larsi@gnus.org>
Commit: Lars Ingebrigtsen <larsi@gnus.org>
Move the Gnus range functions to a new range.el file
* lisp/emacs-lisp/range.el: New file.
* lisp/gnus/gnus-agent.el (range):
(gnus-agent-synchronize-group-flags):
(gnus-agent-possibly-alter-active):
(gnus-agent-fetch-headers):
(gnus-agent-read-agentview):
(gnus-agent-fetch-group-1):
(gnus-agent-read-p):
(gnus-agent-expire-group-1):
(gnus-agent-retrieve-headers): Adjust callers.
* lisp/gnus/gnus-art.el (range):
(gnus-article-describe-bindings):
* lisp/gnus/gnus-cloud.el (range):
(gnus-cloud-available-chunks):
* lisp/gnus/gnus-draft.el (gnus-group-send-queue):
* lisp/gnus/gnus-group.el (range):
(gnus-group-line-format-alist):
(gnus-number-of-unseen-articles-in-group):
(gnus-group-update-eval-form):
(gnus-group-read-group):
(gnus-group-delete-articles):
(gnus-group-catchup):
(gnus-group-expire-articles-1):
(gnus-add-marked-articles):
* lisp/gnus/gnus-int.el (gnus-request-marks):
* lisp/gnus/gnus-kill.el (gnus-apply-kill-file-internal):
* lisp/gnus/gnus-range.el (gnus-range-difference)
(gnus-sorted-range-intersection, gnus-uncompress-range)
(gnus-add-to-range, gnus-remove-from-range)
(gnus-member-of-range, gnus-list-range-intersection)
(gnus-list-range-difference, gnus-range-length, gnus-range-add)
(gnus-range-map): Make into obsolete aliases.
* lisp/gnus/gnus-start.el (gnus-make-articles-unread):
(gnus-convert-old-ticks):
(gnus-read-old-newsrc-el-file):
* lisp/gnus/gnus-sum.el (gnus-select-newsgroup):
(gnus-articles-to-read):
(gnus-articles-to-read):
(gnus-killed-articles):
(gnus-adjust-marked-articles):
(gnus-update-marks):
(gnus-update-marks):
(gnus-compute-read-articles):
(gnus-list-of-read-articles):
(gnus-summary-update-info):
(gnus-summary-move-article):
(gnus-summary-expire-articles):
(gnus-update-read-articles):
(gnus-summary-insert-old-articles):
(gnus-summary-insert-old-articles):
(gnus-summary-insert-old-articles):
* lisp/gnus/mail-source.el (gnus-range):
(gnus-compress-sequence):
* lisp/gnus/nnheader.el (range):
(gnus-range-add):
(nnheader-update-marks-actions):
* lisp/gnus/nnimap.el (nnimap-update-info):
(nnimap-update-info):
(nnimap-update-info):
(nnimap-update-qresync-info):
(nnimap-update-qresync-info):
(nnimap-update-qresync-info):
(nnimap-parse-copied-articles):
* lisp/gnus/nnmaildir.el (nnmaildir-request-update-info):
(nnmaildir-request-update-info):
(nnmaildir-request-expire-articles):
(nnmaildir-request-expire-articles):
(nnmaildir-request-set-mark):
* lisp/gnus/nnmairix.el (nnmairix-request-set-mark):
* lisp/gnus/nnmbox.el (nnmbox-record-active-article):
(nnmbox-record-deleted-article):
* lisp/gnus/nnml.el (nnml-request-compact-group):
* lisp/gnus/nnvirtual.el (nnvirtual-request-expire-articles):
* lisp/gnus/nnselect.el (numbers-by-group):
(nnselect-request-update-info):
(nnselect-push-info):
---
lisp/{gnus/gnus-range.el => emacs-lisp/range.el} | 446 +++++++----------------
lisp/gnus/gnus-agent.el | 45 +--
lisp/gnus/gnus-art.el | 3 +-
lisp/gnus/gnus-cloud.el | 3 +-
lisp/gnus/gnus-draft.el | 2 +-
lisp/gnus/gnus-group.el | 52 +--
lisp/gnus/gnus-int.el | 2 +-
lisp/gnus/gnus-kill.el | 2 +-
lisp/gnus/gnus-range.el | 443 ++--------------------
lisp/gnus/gnus-start.el | 14 +-
lisp/gnus/gnus-sum.el | 64 ++--
lisp/gnus/mail-source.el | 3 +-
lisp/gnus/nnheader.el | 8 +-
lisp/gnus/nnimap.el | 29 +-
lisp/gnus/nnmaildir.el | 16 +-
lisp/gnus/nnmairix.el | 2 +-
lisp/gnus/nnmbox.el | 6 +-
lisp/gnus/nnml.el | 19 +-
lisp/gnus/nnselect.el | 30 +-
lisp/gnus/nnvirtual.el | 2 +-
test/lisp/emacs-lisp/range-tests.el | 65 ++++
21 files changed, 366 insertions(+), 890 deletions(-)
diff --git a/lisp/gnus/gnus-range.el b/lisp/emacs-lisp/range.el
similarity index 51%
copy from lisp/gnus/gnus-range.el
copy to lisp/emacs-lisp/range.el
index da3ff47372..38c2866cd4 100644
--- a/lisp/gnus/gnus-range.el
+++ b/lisp/emacs-lisp/range.el
@@ -1,9 +1,8 @@
-;;; gnus-range.el --- range and sequence functions for Gnus -*-
lexical-binding: t; -*-
+;;; ranges.el --- range functions -*- lexical-binding: t; -*-
;; Copyright (C) 1996-2022 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
-;; Keywords: news
;; This file is part of GNU Emacs.
@@ -22,74 +21,37 @@
;;; Commentary:
-;;; Code:
+;; A "range" is a list that represents a list of integers. A range is
+;; a list containing cons cells of start/end pairs, as well as integers.
+;;
+;; ((2 . 5) 9 (11 . 13))
+;;
+;; represents the list (2 3 4 5 9 11 12 13).
-;;; List and range functions
+;;; Code:
-(defsubst gnus-range-normalize (range)
+(defun 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 list (cdr list)))
- (car list))
-(make-obsolete 'gnus-last-element "use `car' of `last' instead." "27.1")
-
-(define-obsolete-function-alias 'gnus-copy-sequence 'copy-tree "27.1")
-
-;;; We could be using `seq-difference' here, but it's much slower
-;;; on these data sets. See bug#50877.
-(defun gnus-set-difference (list1 list2)
- "Return a list of elements of LIST1 that do not appear in LIST2."
- (let ((hash2 (make-hash-table :test 'eq))
- (result nil))
- (dolist (elt list2) (puthash elt t hash2))
- (dolist (elt list1)
- (unless (gethash elt hash2)
- (setq result (cons elt result))))
- (nreverse result)))
-
-(defun gnus-range-nconcat (&rest ranges)
- "Return a range comprising all the RANGES, which are pre-sorted.
-RANGES will be destructively altered."
- (setq ranges (delete nil ranges))
- (let* ((result (gnus-range-normalize (pop ranges)))
- (last (last result)))
- (dolist (range ranges)
- (setq range (gnus-range-normalize range))
- ;; Normalize the single-number case, so that we don't need to
- ;; special-case that so much.
- (when (numberp (car last))
- (setcar last (cons (car last) (car last))))
- (when (numberp (car range))
- (setcar range (cons (car range) (car range))))
- (if (= (1+ (cdar last)) (caar range))
- (progn
- (setcdr (car last) (cdar range))
- (setcdr last (cdr range)))
- (setcdr last range)
- ;; Denormalize back, since we couldn't join the ranges up.
- (when (= (caar range) (cdar range))
- (setcar range (caar range)))
- (when (= (caar last) (cdar last))
- (setcar last (caar last))))
- (setq last (last last)))
- (if (and (consp (car result))
- (= (length result) 1))
- (car result)
- result)))
-
-(defun gnus-range-difference (range1 range2)
+ (if (listp (cdr-safe range))
+ range
+ (list range)))
+
+(defun range-denormalize (range)
+ "If RANGE contains a single range, then return that.
+If not, return RANGE as is."
+ (if (and (consp (car range))
+ (length= range 1))
+ (car range)
+ range))
+
+(defun 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))
+ (setq range1 (range-normalize range1))
+ (setq range2 (range-normalize range2))
(let* ((new-range (cons nil (copy-sequence range1)))
- (r new-range)
- ) ;; (safe t)
+ (r new-range))
(while (cdr r)
(let* ((r1 (cadr r))
(r2 (car range2))
@@ -104,7 +66,8 @@ Both ranges must be in ascending order."
(setcdr r (cddr r)))
((and (= min1 max1)
(listp r1))
- ;; Inefficient representation: may result from overlap
condition (below)
+ ;; Inefficient representation: may result from overlap
+ ;; condition (below)
(setcar (cdr r) min1))
((not min2)
;; All done with range2
@@ -119,91 +82,13 @@ Both ranges must be in ascending order."
;; Complete overlap: range1 removed
(setcdr r (cddr r)))
(t
- (setcdr r (nconc (list (cons min1 (1- min2)) (cons (1+ max2)
max1)) (cddr r)))))))
+ (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 <."
- (let (out)
- (if (or (null list1) (null list2))
- (or list1 list2)
- (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 out (cons (car list2) out))
- (setq list2 (cdr list2)))))
- (nconc (nreverse out) (or list1 list2)))))
-
-;;;###autoload
-(defun gnus-intersection (list1 list2)
- (declare (obsolete seq-intersection "28.1"))
- (nreverse (seq-intersection list1 list2 #'eq)))
-
-;;;###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))
- (setq out (cons (car list1) out)
- list1 (cdr list1)
- list2 (cdr list2)))
- ((< (car list1) (car list2))
- (setq list1 (cdr list1)))
- (t
- (setq list2 (cdr list2)))))
- (nreverse out)))
-
-;;;###autoload
-(defun gnus-sorted-range-intersection (range1 range2)
- "Return intersection of RANGE1 and RANGE2.
-RANGE1 and RANGE2 have to be sorted over <."
+(defun range-intersection (range1 range2)
+ "Return intersection of RANGE1 and RANGE2."
(let* (out
(min1 (car range1))
(max1 (if (numberp min1)
@@ -239,120 +124,48 @@ RANGE1 and RANGE2 have to be sorted over <."
(setq min2 nil)))) ; incr range2
(unless min1
(setq min1 (car range1)
- max1 (if (numberp min1) min1 (prog1 (cdr min1) (setq min1 (car
min1))))
+ 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))))
+ max2 (if (numberp min2) min2
+ (prog1 (cdr min2) (setq min2 (car min2))))
range2 (cdr range2))))
(cond ((cdr out)
- (nreverse 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)
- (cond ((= (car list1) (car list2))
- (setq prev list1
- list1 (cdr list1)
- list2 (cdr list2)))
- ((< (car list1) (car list2))
- (setcdr prev (cdr list1))
- (setq list1 (cdr list1)))
- (t
- (setq list2 (cdr 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 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))
- (last (car numbers))
- result)
- (if (null numbers)
- nil
- (if (not (listp (cdr numbers)))
- numbers
- (while numbers
- (cond ((= last (car numbers)) nil) ;Omit duplicated number
- ((= (1+ last) (car numbers)) ;Still in sequence
- (setq last (car numbers)))
- (t ;End of one sequence
- (setq result
- (cons (if (= first last) first
- (cons first last))
- result))
- (setq first (car numbers))
- (setq last (car numbers))))
- (setq numbers (cdr numbers)))
- (if (and (not always-list) (null result))
- (if (= first last) (list first) (cons first last))
- (nreverse (cons (if (= first last) first (cons first last))
- result)))))))
-
-(defalias 'gnus-uncompress-sequence 'gnus-uncompress-range)
-(defun gnus-uncompress-range (ranges)
+(defun range-compress-list (numbers)
+ "Convert a sorted list of numbers to a range list."
+ (let ((first (car numbers))
+ (last (car numbers))
+ result)
+ (cond
+ ((null numbers)
+ nil)
+ ((not (listp (cdr numbers)))
+ numbers)
+ (t
+ (while numbers
+ (cond ((= last (car numbers)) nil) ;Omit duplicated number
+ ((= (1+ last) (car numbers)) ;Still in sequence
+ (setq last (car numbers)))
+ (t ;End of one sequence
+ (setq result
+ (cons (if (= first last) first
+ (cons first last))
+ result))
+ (setq first (car numbers))
+ (setq last (car numbers))))
+ (setq numbers (cdr numbers)))
+ (nreverse (cons (if (= first last) first (cons first last))
+ result))))))
+
+(defun range-uncompress (ranges)
"Expand a list of ranges into a list of numbers.
RANGES is either a single range on the form `(num . num)' or a list of
these ranges."
@@ -380,11 +193,11 @@ these ranges."
(setq ranges (cdr ranges)))
(nreverse result)))))
-(defun gnus-add-to-range (ranges list)
+(defun range-add-list (ranges list)
"Return a list of ranges that has all articles from both RANGES and LIST.
Note: LIST has to be sorted over `<'."
(if (not ranges)
- (gnus-compress-sequence list t)
+ (range-compress-list list)
(setq list (copy-sequence list))
(unless (listp (cdr ranges))
(setq ranges (list ranges)))
@@ -400,14 +213,14 @@ Note: LIST has to be sorted over `<'."
(setq temp list)
(setq list (cdr list))
(setcdr temp nil)
- (setq out (nconc (gnus-compress-sequence ilist t) out)))
+ (setq out (nconc (range-compress-list ilist) out)))
(setq highest (or (and (atom (car ranges)) (car ranges))
(cdar ranges)))
(while (and list (<= (car list) highest))
(setq list (cdr list)))
(setq ranges (cdr ranges)))
(when list
- (setq out (nconc (gnus-compress-sequence list t) out)))
+ (setq out (nconc (range-compress-list list) out)))
(setq out (sort out (lambda (r1 r2)
(< (or (and (atom r1) r1) (car r1))
(or (and (atom r2) r2) (car r2))))))
@@ -435,14 +248,14 @@ Note: LIST has to be sorted over `<'."
(setq ranges (cdr ranges)))
out)))
-(defun gnus-remove-from-range (range1 range2)
+(defun range-remove (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. 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 (copy-tree range2)))
(setq range1 (if (listp (cdr range1)) range1 (list range1))
range2 (sort (if (listp (cdr range2)) range2 (list range2))
@@ -451,67 +264,68 @@ modified."
(if (consp e2) (car e2) e2))))
r1 (car range1)
r2 (car range2)
- r1_min (if (consp r1) (car r1) r1)
- r1_max (if (consp r1) (cdr r1) r1)
- r2_min (if (consp r2) (car r2) r2)
- r2_max (if (consp r2) (cdr r2) r2))
+ r1-min (if (consp r1) (car r1) r1)
+ r1-max (if (consp r1) (cdr 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)
- r2_max (if (consp r2) (cdr r2) r2)))
- ((and (<= r2_min r1_min) (<= r1_max r2_max)) ; r2 overlap r1
+ r2-min (if (consp r2) (car r2) r2)
+ r2-max (if (consp r2) (cdr r2) r2)))
+ ((and (<= r2-min r1-min) (<= r1-max r2-max)) ; r2 overlap r1
(pop range1)
(setq r1 (car range1)
- r1_min (if (consp r1) (car r1) r1)
- r1_max (if (consp r1) (cdr r1) r1)))
- ((and (<= r2_min r1_min) (<= r2_max r1_max)) ; r2 overlap min r1
+ r1-min (if (consp r1) (car r1) r1)
+ r1-max (if (consp r1) (cdr r1) r1)))
+ ((and (<= r2-min r1-min) (<= r2-max r1-max)) ; r2 overlap min r1
(pop range2)
- (setq r1_min (1+ r2_max)
+ (setq r1-min (1+ r2-max)
r2 (car range2)
- r2_min (if (consp r2) (car r2) r2)
- r2_max (if (consp r2) (cdr r2) r2)))
- ((and (<= r1_min r2_min) (<= r2_max r1_max)) ; r2 contained in r1
- (if (eq r1_min (1- r2_min))
- (push r1_min out)
- (push (cons r1_min (1- r2_min)) out))
+ r2-min (if (consp r2) (car r2) r2)
+ r2-max (if (consp r2) (cdr r2) r2)))
+ ((and (<= r1-min r2-min) (<= r2-max r1-max)) ; r2 contained in r1
+ (if (eq r1-min (1- r2-min))
+ (push r1-min out)
+ (push (cons r1-min (1- r2-min)) out))
(pop range2)
- (if (< r2_max r1_max) ; finished with r1?
- (setq r1_min (1+ r2_max))
+ (if (< r2-max r1-max) ; finished with r1?
+ (setq r1-min (1+ r2-max))
(pop range1)
(setq r1 (car range1)
- r1_min (if (consp r1) (car r1) r1)
- r1_max (if (consp r1) (cdr r1) r1)))
+ r1-min (if (consp r1) (car r1) r1)
+ r1-max (if (consp r1) (cdr r1) r1)))
(setq r2 (car range2)
- r2_min (if (consp r2) (car r2) r2)
- r2_max (if (consp r2) (cdr r2) r2)))
- ((and (<= r2_min r1_max) (<= r1_max r2_max)) ; r2 overlap max r1
- (if (eq r1_min (1- r2_min))
- (push r1_min out)
- (push (cons r1_min (1- r2_min)) out))
+ r2-min (if (consp r2) (car r2) r2)
+ r2-max (if (consp r2) (cdr r2) r2)))
+ ((and (<= r2-min r1-max) (<= r1-max r2-max)) ; r2 overlap max r1
+ (if (eq r1-min (1- r2-min))
+ (push r1-min out)
+ (push (cons r1-min (1- r2-min)) out))
(pop 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-min (if (consp r1) (car r1) r1)
+ r1-max (if (consp r1) (cdr r1) 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))
+ (if (eq r1-min r1-max)
+ (push r1-min out)
+ (push (cons r1-min r1-max) out))
(setq r1 (car range1)
- r1_min (if (consp r1) (car r1) r1)
- r1_max (if (consp r1) (cdr r1) r1)))))
+ r1-min (if (consp r1) (car r1) r1)
+ r1-max (if (consp r1) (cdr r1) r1)))))
(when r1
- (if (eq r1_min r1_max)
- (push r1_min out)
- (push (cons r1_min r1_max) out))
+ (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))
(nreverse out))))
-(defun gnus-member-of-range (number ranges)
+(defun range-member-p (number ranges)
+ "Say whether NUMBER is in RANGES."
(if (not (listp (cdr ranges)))
(and (>= number (car ranges))
(<= number (cdr ranges)))
@@ -529,10 +343,10 @@ modified."
(setq ranges (cdr ranges)))
(not not-stop))))
-(defun gnus-list-range-intersection (list ranges)
+(defun range-list-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))
+oLIST is a sorted list."
+ (setq ranges (range-normalize ranges))
(let (number result)
(while (setq number (pop list))
(while (and ranges
@@ -542,18 +356,16 @@ LIST is a sorted list."
(setq ranges (cdr ranges)))
(when (and ranges
(if (numberp (car ranges))
- (= (car ranges) number)
+ (= (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)
+(defun range-list-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))
+ (setq ranges (range-normalize ranges))
(let (number result)
(while (setq number (pop list))
(while (and ranges
@@ -569,7 +381,7 @@ LIST is a sorted list."
(push number result)))
(nreverse result)))
-(defun gnus-range-length (range)
+(defun range-length (range)
"Return the length RANGE would have if uncompressed."
(cond
((null range)
@@ -582,7 +394,7 @@ LIST is a sorted list."
(setq sum
(+ sum (if (consp x) (- (cdr x) (car x) -1) 1))))))))
-(defun gnus-range-add (range1 range2)
+(defun range-concat (range1 range2)
"Add RANGE2 to RANGE1 (nondestructively)."
(unless (listp (cdr range1))
(setq range1 (list range1)))
@@ -637,21 +449,9 @@ 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)
+(defun range-map (func range)
"Apply FUNC to each value contained by RANGE."
- (setq range (gnus-range-normalize range))
+ (setq range (range-normalize range))
(while range
(let ((span (pop range)))
(if (numberp span)
@@ -662,6 +462,6 @@ LIST is a sorted list."
(funcall func first)
(setq first (1+ first))))))))
-(provide 'gnus-range)
+(provide 'range)
-;;; gnus-range.el ends here
+;;; range.el ends here
diff --git a/lisp/gnus/gnus-agent.el b/lisp/gnus/gnus-agent.el
index fd66135b5c..e4704b35c8 100644
--- a/lisp/gnus/gnus-agent.el
+++ b/lisp/gnus/gnus-agent.el
@@ -31,6 +31,7 @@
(require 'gnus-srvr)
(require 'gnus-util)
(require 'timer)
+(require 'range)
(eval-when-compile (require 'cl-lib))
(autoload 'gnus-server-update-server "gnus-srvr")
@@ -1219,8 +1220,8 @@ This can be added to `gnus-select-article-hook' or
(cond ((eq mark 'read)
(setf (gnus-info-read info)
(funcall (if (eq what 'add)
- #'gnus-range-add
- #'gnus-remove-from-range)
+ #'range-concat
+ #'range-remove)
(gnus-info-read info)
range))
(gnus-get-unread-articles-in-group
@@ -1233,8 +1234,8 @@ This can be added to `gnus-select-article-hook' or
(gnus-info-marks info)))
(setcdr info-marks
(funcall (if (eq what 'add)
- #'gnus-range-add
- #'gnus-remove-from-range)
+ #'range-concat
+ #'range-remove)
(cdr info-marks)
range))))))))
@@ -1307,7 +1308,7 @@ downloaded into the agent."
(let ((read (gnus-info-read info)))
(setf (gnus-info-read info)
- (gnus-range-add
+ (range-concat
read
(list (cons (1+ agent-max)
(1- active-min))))))
@@ -1796,13 +1797,13 @@ article numbers will be returned."
(articles (if fetch-all
(if gnus-newsgroup-maximum-articles
(let ((active (gnus-active group)))
- (gnus-uncompress-range
+ (range-uncompress
(cons (max (car active)
(- (cdr active)
gnus-newsgroup-maximum-articles
-1))
(cdr active))))
- (gnus-uncompress-range (gnus-active group)))
+ (range-uncompress (gnus-active group)))
(gnus-list-of-unread-articles group)))
(gnus-decode-encoded-word-function 'identity)
(gnus-decode-encoded-address-function 'identity)
@@ -1817,7 +1818,7 @@ article numbers will be returned."
;; because otherwise the agent will remove their marks.)
(dolist (arts (gnus-info-marks (gnus-get-info group)))
(unless (memq (car arts) '(seen recent killed cache))
- (setq articles (gnus-range-add articles (cdr arts)))))
+ (setq articles (range-concat articles (cdr arts)))))
(setq articles (sort (gnus-uncompress-sequence articles) #'<)))
;; At this point, I have the list of articles to consider for
@@ -1851,15 +1852,15 @@ article numbers will be returned."
;; gnus-agent-article-alist) equals (cdr (gnus-active
;; group))}. The addition of one(the 1+ above) then
;; forces Low to be greater than High. When this happens,
- ;; gnus-list-range-intersection returns nil which
+ ;; range-list-intersection returns nil which
;; indicates that no headers need to be fetched. -- Kevin
- (setq articles (gnus-list-range-intersection
+ (setq articles (range-list-intersection
articles (list (cons low high)))))))
(when articles
(gnus-message
10 "gnus-agent-fetch-headers: undownloaded articles are `%s'"
- (gnus-compress-sequence articles t)))
+ (range-compress-list articles)))
(with-current-buffer nntp-server-buffer
(if articles
@@ -2060,7 +2061,7 @@ doesn't exist, to valid the overview buffer."
(let (state sequence uncomp)
(while alist
(setq state (caar alist)
- sequence (inline (gnus-uncompress-range (cdar alist)))
+ sequence (inline (range-uncompress (cdar alist)))
alist (cdr alist))
(while sequence
(push (cons (pop sequence) state) uncomp)))
@@ -2404,7 +2405,7 @@ contents, they are first saved to their own file."
(let ((arts (cdr (assq mark (gnus-info-marks
(setq info (gnus-get-info group)))))))
(when arts
- (setq marked-articles (nconc (gnus-uncompress-range arts)
+ (setq marked-articles (nconc (range-uncompress arts)
marked-articles))
))))
(setq marked-articles (sort marked-articles #'<))
@@ -2544,7 +2545,7 @@ contents, they are first saved to their own file."
(let ((read (gnus-info-read
(or info (setq info (gnus-get-info group))))))
(setf (gnus-info-read info)
- (gnus-add-to-range read unfetched-articles)))
+ (range-add-list read unfetched-articles)))
(gnus-group-update-group group t)
(sit-for 0)
@@ -2898,8 +2899,8 @@ The following commands are available:
(defun gnus-agent-read-p ()
"Say whether an article is read or not."
- (gnus-member-of-range (mail-header-number gnus-headers)
- (gnus-info-read (gnus-get-info gnus-newsgroup-name))))
+ (range-member-p (mail-header-number gnus-headers)
+ (gnus-info-read (gnus-get-info gnus-newsgroup-name))))
(defun gnus-category-make-function (predicate)
"Make a function from PREDICATE."
@@ -3115,7 +3116,7 @@ FORCE is equivalent to setting the expiration predicates
to true."
;; All articles EXCEPT those named by the caller
;; are protected from expiration
(gnus-sorted-difference
- (gnus-uncompress-range
+ (range-uncompress
(cons (caar alist)
(caar (last alist))))
(sort articles #'<)))))
@@ -3137,9 +3138,9 @@ FORCE is equivalent to setting the expiration predicates
to true."
;; Ticked and/or dormant articles are excluded
;; from expiration
(nconc
- (gnus-uncompress-range
+ (range-uncompress
(cdr (assq 'tick (gnus-info-marks info))))
- (gnus-uncompress-range
+ (range-uncompress
(cdr (assq 'dormant
(gnus-info-marks info))))))))
(nov-file (concat dir ".overview"))
@@ -3638,7 +3639,7 @@ has been fetched."
(file-name-directory file) t))
(when fetch-old
- (setq articles (gnus-uncompress-range
+ (setq articles (range-uncompress
(cons (if (numberp fetch-old)
(max 1 (- (car articles) fetch-old))
1)
@@ -3694,7 +3695,7 @@ has been fetched."
;; Clip this list to the headers that will
;; actually be returned
- (setq fetched-articles (gnus-list-range-intersection
+ (setq fetched-articles (range-list-intersection
(cdr fetched-articles)
(cons min max)))
@@ -3703,7 +3704,7 @@ has been fetched."
;; excluded IDs may be fetchable using HEAD.
(if (car tail-fetched-articles)
(setq uncached-articles
- (gnus-list-range-intersection
+ (range-list-intersection
uncached-articles
(cons (car uncached-articles)
(car tail-fetched-articles)))))
diff --git a/lisp/gnus/gnus-art.el b/lisp/gnus/gnus-art.el
index a286c44672..d35d3bdd3a 100644
--- a/lisp/gnus/gnus-art.el
+++ b/lisp/gnus/gnus-art.el
@@ -42,6 +42,7 @@
(require 'message)
(require 'mouse)
(require 'seq)
+(require 'range)
(autoload 'gnus-msg-mail "gnus-msg" nil t)
(autoload 'gnus-button-mailto "gnus-msg")
@@ -7019,7 +7020,7 @@ then we display only bindings that start with that
prefix."
(setq sumkeys
(append (mapcar
#'vector
- (nreverse (gnus-uncompress-range def)))
+ (nreverse (range-uncompress def)))
sumkeys))))
((setq def (key-binding key))
(unless (eq def 'undefined)
diff --git a/lisp/gnus/gnus-cloud.el b/lisp/gnus/gnus-cloud.el
index 6ed9e32c91..9bd9f2155f 100644
--- a/lisp/gnus/gnus-cloud.el
+++ b/lisp/gnus/gnus-cloud.el
@@ -30,6 +30,7 @@
(require 'parse-time)
(require 'nnimap)
+(require 'range)
(eval-when-compile (require 'epg)) ;; setf-method for `epg-context-armor'
(autoload 'epg-make-context "epg")
@@ -404,7 +405,7 @@ When FULL is t, upload everything, not just a difference
from the last full."
(let* ((group (gnus-group-full-name gnus-cloud-group-name gnus-cloud-method))
(active (gnus-active group))
headers head)
- (when (gnus-retrieve-headers (gnus-uncompress-range active) group)
+ (when (gnus-retrieve-headers (range-uncompress active) group)
(with-current-buffer nntp-server-buffer
(goto-char (point-min))
(while (setq head (nnheader-parse-head))
diff --git a/lisp/gnus/gnus-draft.el b/lisp/gnus/gnus-draft.el
index cd9b025ff0..56d498cc4d 100644
--- a/lisp/gnus/gnus-draft.el
+++ b/lisp/gnus/gnus-draft.el
@@ -200,7 +200,7 @@ Obeys the standard process/prefix convention."
(gnus-activate-group "nndraft:queue")
(save-excursion
(let* ((articles (nndraft-articles))
- (unsendable (gnus-uncompress-range
+ (unsendable (range-uncompress
(cdr (assq 'unsend
(gnus-info-marks
(gnus-get-info "nndraft:queue"))))))
diff --git a/lisp/gnus/gnus-group.el b/lisp/gnus/gnus-group.el
index ab874dd060..d3a94e9f4e 100644
--- a/lisp/gnus/gnus-group.el
+++ b/lisp/gnus/gnus-group.el
@@ -35,6 +35,7 @@
(require 'gnus-undo)
(require 'gmm-utils)
(require 'time-date)
+(require 'range)
(eval-when-compile
(require 'mm-url)
@@ -512,8 +513,8 @@ simple manner."
((numberp number)
(int-to-string
(+ number
- (gnus-range-length (cdr (assq 'dormant gnus-tmp-marked)))
- (gnus-range-length (cdr (assq 'tick gnus-tmp-marked))))))
+ (range-length (cdr (assq 'dormant gnus-tmp-marked)))
+ (range-length (cdr (assq 'tick gnus-tmp-marked))))))
(t number))
?s)
(?R gnus-tmp-number-of-read ?s)
@@ -523,10 +524,10 @@ simple manner."
?s)
(?t gnus-tmp-number-total ?d)
(?y gnus-tmp-number-of-unread ?s)
- (?I (gnus-range-length (cdr (assq 'dormant gnus-tmp-marked))) ?d)
- (?T (gnus-range-length (cdr (assq 'tick gnus-tmp-marked))) ?d)
- (?i (+ (gnus-range-length (cdr (assq 'dormant gnus-tmp-marked)))
- (gnus-range-length (cdr (assq 'tick gnus-tmp-marked))))
+ (?I (range-length (cdr (assq 'dormant gnus-tmp-marked))) ?d)
+ (?T (range-length (cdr (assq 'tick gnus-tmp-marked))) ?d)
+ (?i (+ (range-length (cdr (assq 'dormant gnus-tmp-marked)))
+ (range-length (cdr (assq 'tick gnus-tmp-marked))))
?d)
(?g gnus-tmp-group ?s)
(?G gnus-tmp-qualified-group ?s)
@@ -1482,9 +1483,9 @@ if it is a string, only list groups matching REGEXP."
(active (gnus-active group)))
(if (not active)
0
- (length (gnus-uncompress-range
- (gnus-range-difference
- (gnus-range-difference (list active) (gnus-info-read info))
+ (length (range-uncompress
+ (range-difference
+ (range-difference (list active) (gnus-info-read info))
seen))))))
;; Moving through the Group buffer (in topic mode) e.g. with C-n doesn't
@@ -1642,7 +1643,7 @@ Some value are bound so the form can use them."
'(mail post-mail))))
(cons 'level (or (gnus-info-level info) gnus-level-killed))
(cons 'score (or (gnus-info-score info) 0))
- (cons 'ticked (gnus-range-length (cdr (assq 'tick marked))))
+ (cons 'ticked (range-length (cdr (assq 'tick marked))))
(cons 'group-age (gnus-group-timestamp-delta group)))))
(while (and list
(not (eval (caar list) env)))
@@ -2065,9 +2066,9 @@ that group."
(- (1+ (cdr active)) (car active)))))
(gnus-summary-read-group
group (or all (and (numberp number)
- (zerop (+ number (gnus-range-length
+ (zerop (+ number (range-length
(cdr (assq 'tick marked)))
- (gnus-range-length
+ (range-length
(cdr (assq 'dormant marked)))))))
no-article nil no-display nil select-articles)))
@@ -2832,7 +2833,7 @@ according to the expiry settings. Note that this will
delete old
not-expirable articles, too."
(interactive (list (gnus-group-group-name) current-prefix-arg)
gnus-group-mode)
- (let ((articles (gnus-uncompress-range (gnus-active group))))
+ (let ((articles (range-uncompress (gnus-active group))))
(when (gnus-yes-or-no-p
(format "Do you really want to delete these %d articles forever? "
(length articles)))
@@ -3755,15 +3756,15 @@ or nil if no action could be taken."
'del '(tick))
(list (cdr (assq 'dormant marks))
'del '(dormant))))
- (setq unread (gnus-range-add (gnus-range-add
- unread (cdr (assq 'dormant marks)))
- (cdr (assq 'tick marks))))
+ (setq unread (range-concat (range-concat
+ unread (cdr (assq 'dormant marks)))
+ (cdr (assq 'tick marks))))
(gnus-add-marked-articles group 'tick nil nil 'force)
(gnus-add-marked-articles group 'dormant nil nil 'force))
;; Do auto-expirable marks if that's required.
(when (and (gnus-group-auto-expirable-p group)
(not (gnus-group-read-only-p group)))
- (gnus-range-map
+ (range-map
(lambda (article)
(gnus-add-marked-articles group 'expire (list article))
(gnus-request-set-mark group (list (list (list article)
@@ -3795,7 +3796,7 @@ Uses the process/prefix convention."
(cons nil (gnus-list-of-read-articles group))
(assq 'expire (gnus-info-marks info))))
(articles-to-expire
- (gnus-list-range-difference
+ (range-list-difference
(gnus-uncompress-sequence (cdr expirable))
(cdr (assq 'unexist (gnus-info-marks info)))))
(expiry-wait (gnus-group-find-parameter group 'expiry-wait))
@@ -4671,23 +4672,22 @@ and the second element is the address."
(and (not (setq marked (nthcdr 3 info)))
(or (null articles)
(setcdr (nthcdr 2 info)
- (list (list (cons type (gnus-compress-sequence
- articles t)))))))
+ (list (list (cons type (range-compress-list
+ articles)))))))
(and (not (setq m (assq type (car marked))))
(or (null articles)
(setcar marked
- (cons (cons type (gnus-compress-sequence articles t) )
+ (cons (cons type (range-compress-list articles))
(car marked)))))
(if force
(if (null articles)
(setcar (nthcdr 3 info)
(assq-delete-all type (car marked)))
- (setcdr m (gnus-compress-sequence articles t)))
- (setcdr m (gnus-compress-sequence
- (sort (nconc (gnus-uncompress-range (cdr m))
+ (setcdr m (range-compress-list articles)))
+ (setcdr m (range-compress-list
+ (sort (nconc (range-uncompress (cdr m))
(copy-sequence articles))
- #'<)
- t))))))
+ #'<)))))))
(declare-function gnus-summary-add-mark "gnus-sum" (article type))
diff --git a/lisp/gnus/gnus-int.el b/lisp/gnus/gnus-int.el
index 5a619e8f07..f00f2a0d04 100644
--- a/lisp/gnus/gnus-int.el
+++ b/lisp/gnus/gnus-int.el
@@ -802,7 +802,7 @@ If GROUP is nil, all groups on COMMAND-METHOD are scanned."
(when (> min 1)
(let* ((range (if (= min 2) 1 (cons 1 (1- min))))
(read (gnus-info-read info))
- (new-read (gnus-range-add read (list range))))
+ (new-read (range-concat read (list range))))
(setf (gnus-info-read info) new-read)))
info))))))
diff --git a/lisp/gnus/gnus-kill.el b/lisp/gnus/gnus-kill.el
index bee7860efd..bc49f8385e 100644
--- a/lisp/gnus/gnus-kill.el
+++ b/lisp/gnus/gnus-kill.el
@@ -349,7 +349,7 @@ Returns the number of articles marked as read."
(setq gnus-newsgroup-kill-headers
(mapcar #'mail-header-number headers))
(while headers
- (unless (gnus-member-of-range
+ (unless (range-member-p
(mail-header-number (car headers))
gnus-newsgroup-killed)
(push (mail-header-number (car headers))
diff --git a/lisp/gnus/gnus-range.el b/lisp/gnus/gnus-range.el
index da3ff47372..23a71bda20 100644
--- a/lisp/gnus/gnus-range.el
+++ b/lisp/gnus/gnus-range.el
@@ -26,10 +26,8 @@
;;; 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)))
+(require 'range)
+(define-obsolete-function-alias 'gnus-range-normalize #'range-normalize "29.1")
(defun gnus-last-element (list)
"Return last element of LIST."
@@ -56,10 +54,10 @@ If RANGE is a single range, return (RANGE). Otherwise,
return RANGE."
"Return a range comprising all the RANGES, which are pre-sorted.
RANGES will be destructively altered."
(setq ranges (delete nil ranges))
- (let* ((result (gnus-range-normalize (pop ranges)))
+ (let* ((result (range-normalize (pop ranges)))
(last (last result)))
(dolist (range ranges)
- (setq range (gnus-range-normalize range))
+ (setq range (range-normalize range))
;; Normalize the single-number case, so that we don't need to
;; special-case that so much.
(when (numberp (car last))
@@ -82,47 +80,8 @@ RANGES will be destructively altered."
(car result)
result)))
-(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 precedes range2
- (pop r))
- ((< max2 min1)
- ;; No overlap: range2 precedes 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)))
-
-
+(define-obsolete-function-alias 'gnus-range-difference
+ #'range-difference "29.1")
;;;###autoload
(defun gnus-sorted-difference (list1 list2)
@@ -200,57 +159,8 @@ LIST1 and LIST2 have to be sorted over <."
(setq list2 (cdr list2)))))
(nreverse out)))
-;;;###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 precedes range2
- (setq range1 (cdr range1)
- min1 nil))
- ((< max2 min1) ; range2 precedes 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)))))
+(define-obsolete-function-alias 'gnus-sorted-range-intersection
+ #'range-intersection "29.1")
;;;###autoload
(defalias 'gnus-set-sorted-intersection 'gnus-sorted-nintersection)
@@ -327,315 +237,33 @@ LIST1 and LIST2 have to be sorted over <."
"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))
- (last (car numbers))
- result)
- (if (null numbers)
- nil
- (if (not (listp (cdr numbers)))
- numbers
- (while numbers
- (cond ((= last (car numbers)) nil) ;Omit duplicated number
- ((= (1+ last) (car numbers)) ;Still in sequence
- (setq last (car numbers)))
- (t ;End of one sequence
- (setq result
- (cons (if (= first last) first
- (cons first last))
- result))
- (setq first (car numbers))
- (setq last (car numbers))))
- (setq numbers (cdr numbers)))
- (if (and (not always-list) (null result))
- (if (= first last) (list first) (cons first last))
- (nreverse (cons (if (= first last) first (cons first last))
- result)))))))
+ (if always-list
+ (range-compress-list numbers)
+ (range-denormalize (range-compress-list numbers))))
(defalias 'gnus-uncompress-sequence 'gnus-uncompress-range)
-(defun gnus-uncompress-range (ranges)
- "Expand a list of ranges into a list of numbers.
-RANGES is either a single range on the form `(num . num)' or a list of
-these ranges."
- (let (first last result)
- (cond
- ((null ranges)
- nil)
- ((not (listp (cdr ranges)))
- (setq first (car ranges))
- (setq last (cdr ranges))
- (while (<= first last)
- (setq result (cons first result))
- (setq first (1+ first)))
- (nreverse result))
- (t
- (while ranges
- (if (atom (car ranges))
- (when (numberp (car ranges))
- (setq result (cons (car ranges) result)))
- (setq first (caar ranges))
- (setq last (cdar ranges))
- (while (<= first last)
- (setq result (cons first result))
- (setq first (1+ first))))
- (setq ranges (cdr ranges)))
- (nreverse result)))))
-
-(defun gnus-add-to-range (ranges list)
- "Return a list of ranges that has all articles from both RANGES and LIST.
-Note: LIST has to be sorted over `<'."
- (if (not ranges)
- (gnus-compress-sequence list t)
- (setq list (copy-sequence list))
- (unless (listp (cdr ranges))
- (setq ranges (list ranges)))
- (let ((out ranges)
- ilist lowest highest temp)
- (while (and ranges list)
- (setq ilist list)
- (setq lowest (or (and (atom (car ranges)) (car ranges))
- (caar ranges)))
- (while (and list (cdr list) (< (cadr list) lowest))
- (setq list (cdr list)))
- (when (< (car ilist) lowest)
- (setq temp list)
- (setq list (cdr list))
- (setcdr temp nil)
- (setq out (nconc (gnus-compress-sequence ilist t) out)))
- (setq highest (or (and (atom (car ranges)) (car ranges))
- (cdar ranges)))
- (while (and list (<= (car list) highest))
- (setq list (cdr list)))
- (setq ranges (cdr ranges)))
- (when list
- (setq out (nconc (gnus-compress-sequence list t) out)))
- (setq out (sort out (lambda (r1 r2)
- (< (or (and (atom r1) r1) (car r1))
- (or (and (atom r2) r2) (car r2))))))
- (setq ranges out)
- (while ranges
- (if (atom (car ranges))
- (when (cdr ranges)
- (if (atom (cadr ranges))
- (when (= (1+ (car ranges)) (cadr ranges))
- (setcar ranges (cons (car ranges)
- (cadr ranges)))
- (setcdr ranges (cddr ranges)))
- (when (= (1+ (car ranges)) (caadr ranges))
- (setcar (cadr ranges) (car ranges))
- (setcar ranges (cadr ranges))
- (setcdr ranges (cddr ranges)))))
- (when (cdr ranges)
- (if (atom (cadr ranges))
- (when (= (1+ (cdar ranges)) (cadr ranges))
- (setcdr (car ranges) (cadr ranges))
- (setcdr ranges (cddr ranges)))
- (when (= (1+ (cdar ranges)) (caadr ranges))
- (setcdr (car ranges) (cdadr ranges))
- (setcdr ranges (cddr ranges))))))
- (setq ranges (cdr ranges)))
- 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. 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
- (range2 (copy-tree range2)))
- (setq range1 (if (listp (cdr range1)) range1 (list range1))
- 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)
- r1_max (if (consp r1) (cdr 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
- (pop range2)
- (setq r2 (car range2)
- r2_min (if (consp r2) (car r2) r2)
- r2_max (if (consp r2) (cdr r2) r2)))
- ((and (<= r2_min r1_min) (<= r1_max r2_max)) ; r2 overlap r1
- (pop range1)
- (setq r1 (car range1)
- r1_min (if (consp r1) (car r1) r1)
- r1_max (if (consp r1) (cdr r1) r1)))
- ((and (<= r2_min r1_min) (<= r2_max r1_max)) ; r2 overlap min r1
- (pop range2)
- (setq r1_min (1+ r2_max)
- r2 (car range2)
- r2_min (if (consp r2) (car r2) r2)
- r2_max (if (consp r2) (cdr r2) r2)))
- ((and (<= r1_min r2_min) (<= r2_max r1_max)) ; r2 contained in r1
- (if (eq r1_min (1- r2_min))
- (push r1_min out)
- (push (cons r1_min (1- r2_min)) out))
- (pop range2)
- (if (< r2_max r1_max) ; finished with r1?
- (setq r1_min (1+ r2_max))
- (pop range1)
- (setq r1 (car range1)
- r1_min (if (consp r1) (car r1) r1)
- r1_max (if (consp r1) (cdr r1) r1)))
- (setq r2 (car range2)
- r2_min (if (consp r2) (car r2) r2)
- r2_max (if (consp r2) (cdr r2) r2)))
- ((and (<= r2_min r1_max) (<= r1_max r2_max)) ; r2 overlap max r1
- (if (eq r1_min (1- r2_min))
- (push r1_min out)
- (push (cons r1_min (1- r2_min)) out))
- (pop 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
- (pop range1)
- (if (eq r1_min r1_max)
- (push r1_min out)
- (push (cons r1_min r1_max) out))
- (setq r1 (car range1)
- r1_min (if (consp r1) (car r1) r1)
- r1_max (if (consp r1) (cdr r1) r1)))))
- (when r1
- (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))
- (nreverse out))))
-
-(defun gnus-member-of-range (number ranges)
- (if (not (listp (cdr ranges)))
- (and (>= number (car ranges))
- (<= number (cdr ranges)))
- (let ((not-stop t))
- (while (and ranges
- (if (numberp (car ranges))
- (>= number (car ranges))
- (>= number (caar ranges)))
- not-stop)
- (when (if (numberp (car ranges))
- (= number (car ranges))
- (and (>= number (caar ranges))
- (<= number (cdar ranges))))
- (setq not-stop nil))
- (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)))
+(define-obsolete-function-alias 'gnus-uncompress-range
+ #'range-uncompress "29.1")
+
+(define-obsolete-function-alias 'gnus-add-to-range
+ #'range-add-list "29.1")
+
+(define-obsolete-function-alias 'gnus-remove-from-range
+ #'range-remove "29.1")
+
+(define-obsolete-function-alias 'gnus-member-of-range #'range-member-p "29.1")
+
+(define-obsolete-function-alias 'gnus-list-range-intersection
+ #'range-list-intersection "29.1")
(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)))
+(define-obsolete-function-alias 'gnus-list-range-difference
+ #'range-list-difference "29.1")
+
+(define-obsolete-function-alias 'gnus-range-length #'range-length "29.1")
-(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-range-add (range1 range2)
- "Add RANGE2 to RANGE1 (nondestructively)."
- (unless (listp (cdr range1))
- (setq range1 (list range1)))
- (unless (listp (cdr range2))
- (setq range2 (list range2)))
- (let ((item1 (pop range1))
- (item2 (pop range2))
- range item selector)
- (while (or item1 item2)
- (setq selector
- (cond
- ((null item1) nil)
- ((null item2) t)
- ((and (numberp item1) (numberp item2)) (< item1 item2))
- ((numberp item1) (< item1 (car item2)))
- ((numberp item2) (< (car item1) item2))
- (t (< (car item1) (car item2)))))
- (setq item
- (or
- (let ((tmp1 item) (tmp2 (if selector item1 item2)))
- (cond
- ((null tmp1) tmp2)
- ((null tmp2) tmp1)
- ((and (numberp tmp1) (numberp tmp2))
- (cond
- ((eq tmp1 tmp2) tmp1)
- ((eq (1+ tmp1) tmp2) (cons tmp1 tmp2))
- ((eq (1+ tmp2) tmp1) (cons tmp2 tmp1))
- (t nil)))
- ((numberp tmp1)
- (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
- ((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))
- (max (cdr tmp1) (cdr tmp2))))))
- (progn
- (if item (push item range))
- (if selector item1 item2))))
- (if selector
- (setq item1 (pop range1))
- (setq item2 (pop range2))))
- (if item (push item range))
- (reverse range)))
+(define-obsolete-function-alias 'gnus-range-add #'range-concat "29.1")
;;;###autoload
(defun gnus-add-to-sorted-list (list num)
@@ -649,18 +277,7 @@ LIST is a sorted list."
(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))))))))
+(define-obsolete-function-alias 'gnus-range-map #'range-map "29.1")
(provide 'gnus-range)
diff --git a/lisp/gnus/gnus-start.el b/lisp/gnus/gnus-start.el
index 252e6e2229..2cf11fb12f 100644
--- a/lisp/gnus/gnus-start.el
+++ b/lisp/gnus/gnus-start.el
@@ -1884,13 +1884,12 @@ The info element is shared with the same element of
(ranges (gnus-info-read info))
news article)
(while articles
- (when (gnus-member-of-range
- (setq article (pop articles)) ranges)
+ (when (range-member-p (setq article (pop articles)) ranges)
(push article news)))
(when news
;; Enter this list into the group info.
(setf (gnus-info-read info)
- (gnus-remove-from-range (gnus-info-read info) (nreverse news)))
+ (range-remove (gnus-info-read info) (nreverse news)))
;; Set the number of unread articles in gnus-newsrc-hashtb.
(gnus-get-unread-articles-in-group info (gnus-active group))
@@ -2362,10 +2361,10 @@ The form should return either t or nil."
ticked (cdr (assq 'tick marks)))
(when (or dormant ticked)
(setf (gnus-info-read info)
- (gnus-add-to-range
+ (range-add-list
(gnus-info-read info)
- (nconc (gnus-uncompress-range dormant)
- (gnus-uncompress-range ticked)))))))))
+ (nconc (range-uncompress dormant)
+ (range-uncompress ticked)))))))))
(defun gnus-load (file)
"Load FILE, but in such a way that read errors can be reported."
@@ -2457,8 +2456,7 @@ The form should return either t or nil."
(unless (nthcdr 3 info)
(nconc info (list nil)))
(setf (gnus-info-marks info)
- (list (cons 'tick (gnus-compress-sequence
- (sort (cdr m) #'<) t))))))
+ (list (cons 'tick (range-compress-list (sort (cdr m) #'<)))))))
(setq newsrc killed)
(while newsrc
(setcar newsrc (caar newsrc))
diff --git a/lisp/gnus/gnus-sum.el b/lisp/gnus/gnus-sum.el
index 6dfdcaf55c..8fb07d5905 100644
--- a/lisp/gnus/gnus-sum.el
+++ b/lisp/gnus/gnus-sum.el
@@ -5755,7 +5755,7 @@ If SELECT-ARTICLES, only select those articles from
GROUP."
;; (let ((n (cdr (gnus-active group))))
;; (lambda () (> number (- n display))))
(setq select-articles
- (gnus-uncompress-range
+ (range-uncompress
(cons (let ((tmp (- (cdr (gnus-active group)) display)))
(if (> tmp 0)
tmp
@@ -5928,7 +5928,7 @@ If SELECT-ARTICLES, only select those articles from
GROUP."
"Find out what articles the user wants to read."
(let* ((only-read-p t)
(articles
- (gnus-list-range-difference
+ (range-list-difference
;; Select all articles if `read-all' is non-nil, or if there
;; are no unread articles.
(if (or read-all
@@ -5943,13 +5943,13 @@ If SELECT-ARTICLES, only select those articles from
GROUP."
(or
(if gnus-newsgroup-maximum-articles
(let ((active (gnus-active group)))
- (gnus-uncompress-range
+ (range-uncompress
(cons (max (car active)
(- (cdr active)
gnus-newsgroup-maximum-articles
-1))
(cdr active))))
- (gnus-uncompress-range (gnus-active group)))
+ (range-uncompress (gnus-active group)))
(gnus-cache-articles-in-group group))
;; Select only the "normal" subset of articles.
(setq only-read-p nil)
@@ -6040,7 +6040,7 @@ If SELECT-ARTICLES, only select those articles from
GROUP."
(defun gnus-killed-articles (killed articles)
(let (out)
(while articles
- (when (inline (gnus-member-of-range (car articles) killed))
+ (when (inline (range-member-p (car articles) killed))
(push (car articles) out))
(setq articles (cdr articles)))
out))
@@ -6078,7 +6078,7 @@ If SELECT-ARTICLES, only select those articles from
GROUP."
;; Adjust "simple" lists - compressed yet unsorted
((eq mark-type 'list)
;; Simultaneously uncompress and clip to active range
- ;; See gnus-uncompress-range for a description of possible marks
+ ;; See range-uncompress for a description of possible marks
(let (l lh)
(if (not (cadr marks))
(set var nil)
@@ -6177,10 +6177,10 @@ If SELECT-ARTICLES, only select those articles from
GROUP."
;; When exiting the group, everything that's previously been
;; unseen is now seen.
(when (eq (cdr type) 'seen)
- (setq list (gnus-range-add list gnus-newsgroup-unseen)))
+ (setq list (range-concat list gnus-newsgroup-unseen)))
(when (eq (gnus-article-mark-to-type (cdr type)) 'list)
- (setq list (gnus-compress-sequence (set symbol (sort list #'<)) t)))
+ (setq list (range-compress-list (set symbol (sort list #'<)))))
(when (and (gnus-check-backend-function
'request-set-mark gnus-newsgroup-name)
@@ -6189,20 +6189,19 @@ If SELECT-ARTICLES, only select those articles from
GROUP."
;; Don't do anything about marks for articles we
;; didn't actually get any headers for.
(del
- (gnus-list-range-intersection
+ (range-list-intersection
gnus-newsgroup-articles
- (gnus-remove-from-range (copy-tree old) list)))
+ (range-remove (copy-tree old) list)))
(add
- (gnus-list-range-intersection
+ (range-list-intersection
gnus-newsgroup-articles
- (gnus-remove-from-range
- (copy-tree list) old))))
+ (range-remove (copy-tree list) old))))
(when add
(push (list add 'add (list (cdr type))) delta-marks))
(when del
;; Don't delete marks from outside the active range.
;; This shouldn't happen, but is a sanity check.
- (setq del (gnus-sorted-range-intersection
+ (setq del (range-intersection
(gnus-active gnus-newsgroup-name) del))
(push (list del 'del (list (cdr type))) delta-marks))))
@@ -6386,7 +6385,7 @@ The resulting hash table is returned, or nil if no Xrefs
were found."
(setq ninfo (cons 1 (1- (car active))))
(setq ninfo (gnus-info-read info)))
;; Then we add the read articles to the range.
- (gnus-add-to-range
+ (range-add-list
ninfo (setq articles (sort articles #'<))))))
(defun gnus-group-make-articles-read (group articles)
@@ -6967,10 +6966,10 @@ displayed, no centering will be performed."
(marked (gnus-info-marks info))
(active (gnus-active group)))
(and info active
- (gnus-list-range-difference
- (gnus-list-range-difference
+ (range-list-difference
+ (range-list-difference
(gnus-sorted-complement
- (gnus-uncompress-range
+ (range-uncompress
(if gnus-newsgroup-maximum-articles
(cons (max (car active)
(- (cdr active)
@@ -7129,12 +7128,11 @@ The prefix argument ALL means to select all articles."
(when group
(when gnus-newsgroup-kill-headers
(setq gnus-newsgroup-killed
- (gnus-compress-sequence
+ (range-compress-list
(gnus-sorted-union
- (gnus-list-range-intersection
+ (range-list-intersection
gnus-newsgroup-unselected gnus-newsgroup-killed)
- gnus-newsgroup-unreads)
- t)))
+ gnus-newsgroup-unreads))))
(unless (listp (cdr gnus-newsgroup-killed))
(setq gnus-newsgroup-killed (list gnus-newsgroup-killed)))
(let ((headers gnus-newsgroup-headers)
@@ -10241,8 +10239,8 @@ ACTION can be either `move' (the default), `crosspost'
or `copy'."
(cdr art-group))
(push 'read to-marks)
(setf (gnus-info-read info)
- (gnus-add-to-range (gnus-info-read info)
- (list (cdr art-group)))))
+ (range-add-list (gnus-info-read info)
+ (list (cdr art-group)))))
;; See whether the article is to be put in the cache.
(let* ((expirable (gnus-group-auto-expirable-p to-group))
@@ -10525,7 +10523,7 @@ This will be the case if the article has both been
mailed and posted."
;; This backend supports expiry.
(let* ((total (gnus-group-total-expirable-p gnus-newsgroup-name))
(expirable
- (gnus-list-range-difference
+ (range-list-difference
(if total
(progn
;; We need to update the info for
@@ -12874,8 +12872,8 @@ UNREAD is a sorted list."
(gnus-find-method-for-group group)
'server-marks)
(gnus-check-backend-function 'request-set-mark group))
- (let ((del (gnus-remove-from-range (gnus-info-read info) read))
- (add (gnus-remove-from-range read (gnus-info-read info))))
+ (let ((del (range-remove (gnus-info-read info) read))
+ (add (range-remove read (gnus-info-read info))))
(when (or add del)
(unless (gnus-check-group group)
(error "Can't open server for %s" group))
@@ -13133,10 +13131,10 @@ If ALL is a number, fetch this number of articles."
;; Some nntp servers lie about their active range. When
;; this happens, the active range can be in the millions.
;; Use a compressed range to avoid creating a huge list.
- (gnus-range-difference
- (gnus-range-difference (list gnus-newsgroup-active) old)
+ (range-difference
+ (range-difference (list gnus-newsgroup-active) old)
gnus-newsgroup-unexist))
- (setq len (gnus-range-length older))
+ (setq len (range-length older))
(cond
((null older) nil)
((numberp all)
@@ -13153,9 +13151,9 @@ If ALL is a number, fetch this number of articles."
(push max older)
(setq all (1- all)
max (1- max))))))
- (setq older (gnus-uncompress-range older))))
+ (setq older (range-uncompress older))))
(all
- (setq older (gnus-uncompress-range older)))
+ (setq older (range-uncompress older)))
(t
(when (and (numberp gnus-large-newsgroup)
(> len gnus-large-newsgroup))
@@ -13190,7 +13188,7 @@ If ALL is a number, fetch this number of articles."
(push max older)
(setq all (1- all)
max (1- max))))))))))
- (setq older (gnus-uncompress-range older))))
+ (setq older (range-uncompress older))))
(if (not older)
(message "No old news.")
(gnus-summary-insert-articles older)
diff --git a/lisp/gnus/mail-source.el b/lisp/gnus/mail-source.el
index 9a48f710e5..5d0c0e2654 100644
--- a/lisp/gnus/mail-source.el
+++ b/lisp/gnus/mail-source.el
@@ -31,6 +31,7 @@
(autoload 'pop3-movemail "pop3")
(autoload 'pop3-get-message-count "pop3")
(require 'mm-util)
+(require 'gnus-range)
(require 'message) ;; for `message-directory'
(defvar display-time-mail-function)
@@ -1048,8 +1049,6 @@ This only works when `display-time' is enabled."
(autoload 'imap-range-to-message-set "imap")
(autoload 'nnheader-ms-strip-cr "nnheader")
-(autoload 'gnus-compress-sequence "gnus-range")
-
(defvar mail-source-imap-file-coding-system 'binary
"Coding system for the crashbox made by `mail-source-fetch-imap'.")
diff --git a/lisp/gnus/nnheader.el b/lisp/gnus/nnheader.el
index 8b3718ed7e..c1c5f00ff7 100644
--- a/lisp/gnus/nnheader.el
+++ b/lisp/gnus/nnheader.el
@@ -27,6 +27,7 @@
;;; Code:
(eval-when-compile (require 'cl-lib))
+(require 'range)
(defvar gnus-decode-encoded-word-function)
(defvar gnus-decode-encoded-address-function)
@@ -44,8 +45,6 @@
(require 'mm-util)
(require 'gnus-util)
(autoload 'gnus-remove-odd-characters "gnus-sum")
-(autoload 'gnus-range-add "gnus-range")
-(autoload 'gnus-remove-from-range "gnus-range")
;; FIXME none of these are used explicitly in this file.
(autoload 'gnus-sorted-intersection "gnus-range")
(autoload 'gnus-intersection "gnus-range")
@@ -1044,10 +1043,9 @@ See `find-file-noselect' for the arguments."
mark
(cond
((eq what 'add)
- (gnus-range-add (cdr (assoc mark backend-marks)) range))
+ (range-concat (cdr (assoc mark backend-marks)) range))
((eq what 'del)
- (gnus-remove-from-range
- (cdr (assoc mark backend-marks)) range))
+ (range-remove (cdr (assoc mark backend-marks)) range))
((eq what 'set)
range))
backend-marks)))))
diff --git a/lisp/gnus/nnimap.el b/lisp/gnus/nnimap.el
index cff628061e..afd5418912 100644
--- a/lisp/gnus/nnimap.el
+++ b/lisp/gnus/nnimap.el
@@ -1660,13 +1660,13 @@ If LIMIT, first try to limit the search to the N last
articles."
(cdr (assoc '%Seen flags))
(cdr (assoc '%Deleted flags))))
(cdr (assoc '%Flagged flags)))))
- (read (gnus-range-difference
+ (read (range-difference
(cons start-article high) unread)))
(when (> start-article 1)
(setq read
(gnus-range-nconcat
(if (> start-article 1)
- (gnus-sorted-range-intersection
+ (range-intersection
(cons 1 (1- start-article))
(gnus-info-read info))
(gnus-info-read info))
@@ -1691,7 +1691,7 @@ If LIMIT, first try to limit the search to the N last
articles."
(pop old-marks)
(when (and old-marks
(> start-article 1))
- (setq old-marks (gnus-range-difference
+ (setq old-marks (range-difference
old-marks
(cons start-article high)))
(setq new-marks (gnus-range-nconcat old-marks new-marks)))
@@ -1702,15 +1702,15 @@ If LIMIT, first try to limit the search to the N last
articles."
(active (gnus-active group))
(unexists
(if completep
- (gnus-range-difference
+ (range-difference
active
(gnus-compress-sequence existing))
- (gnus-add-to-range
+ (range-add-list
(cdr old-unexists)
- (gnus-list-range-difference
+ (range-list-difference
existing (gnus-active group))))))
(when (> (car active) 1)
- (setq unexists (gnus-range-add
+ (setq unexists (range-concat
(cons 1 (1- (car active)))
unexists)))
(if old-unexists
@@ -1733,10 +1733,9 @@ If LIMIT, first try to limit the search to the N last
articles."
(defun nnimap-update-qresync-info (info existing vanished flags)
;; Add all the vanished articles to the list of read articles.
(setf (gnus-info-read info)
- (gnus-add-to-range
- (gnus-add-to-range
- (gnus-range-add (gnus-info-read info)
- vanished)
+ (range-add-list
+ (range-add-list
+ (range-concat (gnus-info-read info) vanished)
(cdr (assq '%Flagged flags)))
(cdr (assq '%Seen flags))))
(let ((marks (gnus-info-marks info)))
@@ -1750,9 +1749,9 @@ If LIMIT, first try to limit the search to the N last
articles."
(setq marks (delq ticks marks))
(pop ticks)
;; Add the new marks we got.
- (setq ticks (gnus-add-to-range ticks new-marks))
+ (setq ticks (range-add-list ticks new-marks))
;; Remove the marks from messages that don't have them.
- (setq ticks (gnus-remove-from-range
+ (setq ticks (range-remove
ticks
(gnus-compress-sequence
(gnus-sorted-complement existing new-marks))))
@@ -1762,7 +1761,7 @@ If LIMIT, first try to limit the search to the N last
articles."
;; Add vanished to the list of unexisting articles.
(when vanished
(let* ((old-unexists (assq 'unexist marks))
- (unexists (gnus-range-add (cdr old-unexists) vanished)))
+ (unexists (range-concat (cdr old-unexists) vanished)))
(if old-unexists
(setcdr old-unexists unexists)
(push (cons 'unexist unexists) marks)))
@@ -2242,7 +2241,7 @@ Return the server's response to the SELECT or EXAMINE
command."
(while (re-search-forward "^\\([0-9]+\\) OK\\b" nil t)
(setq sequence (string-to-number (match-string 1)))
(when (setq range (cadr (assq sequence sequences)))
- (push (gnus-uncompress-range range) copied)))
+ (push (range-uncompress range) copied)))
(gnus-compress-sequence (sort (apply #'nconc copied) #'<))))
(defun nnimap-new-articles (flags)
diff --git a/lisp/gnus/nnmaildir.el b/lisp/gnus/nnmaildir.el
index 690761a2d6..30f473b129 100644
--- a/lisp/gnus/nnmaildir.el
+++ b/lisp/gnus/nnmaildir.el
@@ -1006,10 +1006,10 @@ This variable is set by `nnmaildir-request-article'.")
existing (nnmaildir--grp-nlist group)
existing (mapcar #'car existing)
existing (nreverse existing)
- existing (gnus-compress-sequence existing 'always-list)
+ existing (range-compress-list existing)
missing (list (cons 1 (nnmaildir--group-maxnum
nnmaildir--cur-server group)))
- missing (gnus-range-difference missing existing)
+ missing (range-difference missing existing)
dir (nnmaildir--srv-dir nnmaildir--cur-server)
dir (nnmaildir--srvgrp-dir dir gname)
dir (nnmaildir--nndir dir)
@@ -1076,10 +1076,10 @@ This variable is set by `nnmaildir-request-article'.")
(let ((article (nnmaildir--flist-art flist prefix)))
(when article
(push (nnmaildir--art-num article) article-list))))))
- (setq ranges (gnus-add-to-range ranges (sort article-list #'<)))))
+ (setq ranges (range-add-list ranges (sort article-list #'<)))))
(if (eq mark 'read) (setq read ranges)
(if ranges (setq marks (cons (cons mark ranges) marks)))))
- (setf (gnus-info-read info) (gnus-range-add read missing))
+ (setf (gnus-info-read info) (range-concat read missing))
(gnus-info-set-marks info marks 'extend)
(setf (nnmaildir--grp-mmth group) new-mmth)
info)))
@@ -1548,11 +1548,11 @@ This variable is set by `nnmaildir-request-article'.")
(unless group
(setf (nnmaildir--srv-error nnmaildir--cur-server)
(if gname (concat "No such group: " gname) "No current group"))
- (throw 'return (gnus-uncompress-range ranges)))
+ (throw 'return (range-uncompress ranges)))
(setq gname (nnmaildir--grp-name group)
pgname (nnmaildir--pgname nnmaildir--cur-server gname))
(if (nnmaildir--param pgname 'read-only)
- (throw 'return (gnus-uncompress-range ranges)))
+ (throw 'return (range-uncompress ranges)))
(setq time (nnmaildir--param pgname 'expire-age))
(unless time
(setq time (or (and nnmail-expiry-wait-function
@@ -1564,7 +1564,7 @@ This variable is set by `nnmaildir-request-article'.")
(setq time (round (* time 86400))))))
(when no-force
(unless (integerp time) ;; handle 'never
- (throw 'return (gnus-uncompress-range ranges)))
+ (throw 'return (range-uncompress ranges)))
(setq boundary (time-since time)))
(setq dir (nnmaildir--srv-dir nnmaildir--cur-server)
dir (nnmaildir--srvgrp-dir dir gname)
@@ -1686,7 +1686,7 @@ This variable is set by `nnmaildir-request-article'.")
(setf (nnmaildir--srv-error nnmaildir--cur-server)
(concat "No such group: " gname))
(dolist (action actions)
- (setq ranges (gnus-range-add ranges (car action))))
+ (setq ranges (range-concat ranges (car action))))
(throw 'return ranges))
(setq nlist (nnmaildir--grp-nlist group)
marksdir (nnmaildir--srv-dir nnmaildir--cur-server)
diff --git a/lisp/gnus/nnmairix.el b/lisp/gnus/nnmairix.el
index 8ca1cf0fe8..4e8e329f98 100644
--- a/lisp/gnus/nnmairix.el
+++ b/lisp/gnus/nnmairix.el
@@ -597,7 +597,7 @@ Other back ends might or might not work.")
(dolist (cur actions)
(let ((type (nth 1 cur))
(cmdmarks (nth 2 cur))
- (range (gnus-uncompress-range (nth 0 cur)))
+ (range (range-uncompress (nth 0 cur)))
mid ogroup temp) ;; number method
(when (and corr
(not (zerop (cadr corr))))
diff --git a/lisp/gnus/nnmbox.el b/lisp/gnus/nnmbox.el
index 5a350aac74..96ecc34e15 100644
--- a/lisp/gnus/nnmbox.el
+++ b/lisp/gnus/nnmbox.el
@@ -529,7 +529,7 @@
;; add article to index, either by building complete list
;; in reverse order, or as a list of ranges.
(if (not nnmbox-group-building-active-articles)
- (setcdr entry (gnus-add-to-range (cdr entry) (list article)))
+ (setcdr entry (range-add-list (cdr entry) (list article)))
(when (memq article (cdr entry))
(switch-to-buffer nnmbox-mbox-buffer)
(error "Article %s:%d already exists!" group article))
@@ -548,10 +548,10 @@
nnmbox-group-active-articles)
(car nnmbox-group-active-articles)))))
;; remove article from index
- (setcdr entry (gnus-remove-from-range (cdr entry) (list article)))))
+ (setcdr entry (range-remove (cdr entry) (list article)))))
(defun nnmbox-is-article-active-p (article)
- (gnus-member-of-range
+ (range-member-p
article
(cdr (assoc nnmbox-current-group
nnmbox-group-active-articles))))
diff --git a/lisp/gnus/nnml.el b/lisp/gnus/nnml.el
index afdb0c780a..7fe2b516cc 100644
--- a/lisp/gnus/nnml.el
+++ b/lisp/gnus/nnml.el
@@ -1078,21 +1078,20 @@ Use the nov database for the current group if
available."
;; #### doing anything on them.
;; 2 a/ read articles:
(let ((read (gnus-info-read info)))
- (setq read (gnus-remove-from-range read (list new-number)))
- (when (gnus-member-of-range old-number read)
- (setq read (gnus-remove-from-range read (list old-number)))
- (setq read (gnus-add-to-range read (list new-number))))
+ (setq read (range-remove read (list new-number)))
+ (when (range-member-p old-number read)
+ (setq read (range-remove read (list old-number)))
+ (setq read (range-add-list read (list new-number))))
(setf (gnus-info-read info) read))
;; 2 b/ marked articles:
(let ((oldmarks (gnus-info-marks info))
mark newmarks)
(while (setq mark (pop oldmarks))
- (setcdr mark (gnus-remove-from-range (cdr mark)
- (list new-number)))
- (when (gnus-member-of-range old-number (cdr mark))
- (setcdr mark (gnus-remove-from-range (cdr mark)
- (list old-number)))
- (setcdr mark (gnus-add-to-range (cdr mark)
+ (setcdr mark (range-remove (cdr mark) (list new-number)))
+ (when (range-member-p old-number (cdr mark))
+ (setcdr mark (range-remove (cdr mark)
+ (list old-number)))
+ (setcdr mark (range-add-list (cdr mark)
(list new-number))))
(push mark newmarks))
(setf (gnus-info-marks info) newmarks))
diff --git a/lisp/gnus/nnselect.el b/lisp/gnus/nnselect.el
index 9d744ea411..205456a57d 100644
--- a/lisp/gnus/nnselect.el
+++ b/lisp/gnus/nnselect.el
@@ -207,7 +207,7 @@ as `(keyfunc member)' and the corresponding element is just
(inline-quote
(cond
((eq ,type 'range)
- (nnselect-categorize (gnus-uncompress-range ,articles)
+ (nnselect-categorize (range-uncompress ,articles)
#'nnselect-article-group #'nnselect-article-number))
((eq ,type 'tuple)
(nnselect-categorize ,articles
@@ -542,10 +542,10 @@ If this variable is nil, or if the provided function
returns nil,
(group-info (gnus-get-info artgroup))
(marks (gnus-info-marks group-info))
(unread (gnus-uncompress-sequence
- (gnus-range-difference (gnus-active artgroup)
- (gnus-info-read group-info)))))
+ (range-difference (gnus-active artgroup)
+ (gnus-info-read group-info)))))
(setf (gnus-info-read info)
- (gnus-add-to-range
+ (range-add-list
(gnus-info-read info)
(delq nil (mapcar
(lambda (art)
@@ -567,7 +567,7 @@ If this variable is nil, or if the provided function
returns nil,
artids))
(t
(setq mark-list
- (gnus-uncompress-range mark-list))
+ (range-uncompress mark-list))
(mapcar
(lambda (id)
(when (memq (cdr id) mark-list)
@@ -866,16 +866,16 @@ article came from is also searched."
(when (and (gnus-check-backend-function
'request-set-mark artgroup)
(not (gnus-article-unpropagatable-p type)))
- (let* ((old (gnus-list-range-intersection
+ (let* ((old (range-list-intersection
artlist
(alist-get type (gnus-info-marks group-info))))
- (del (gnus-remove-from-range (copy-tree old) list))
- (add (gnus-remove-from-range (copy-tree list) old)))
+ (del (range-remove (copy-tree old) list))
+ (add (range-remove (copy-tree list) old)))
(when add (push (list add 'add (list type)) delta-marks))
(when del
;; Don't delete marks from outside the active range.
;; This shouldn't happen, but is a sanity check.
- (setq del (gnus-sorted-range-intersection
+ (setq del (range-intersection
(gnus-active artgroup) del))
(push (list del 'del (list type)) delta-marks))))
@@ -910,18 +910,18 @@ article came from is also searched."
(< (car elt1) (car elt2))))))
(t
(setq list
- (gnus-compress-sequence
+ (range-compress-list
(gnus-sorted-union
(gnus-sorted-difference
(gnus-uncompress-sequence
(alist-get type (gnus-info-marks group-info)))
artlist)
- (sort list #'<)) t)))
+ (sort list #'<)))))
;; When exiting the group, everything that's previously been
;; unseen is now seen.
(when (eq type 'seen)
- (setq list (gnus-range-add
+ (setq list (range-concat
list (cdr (assoc artgroup select-unseen))))))
(when (or list (eq type 'unexist))
@@ -944,9 +944,9 @@ article came from is also searched."
;; update read and unread
(gnus-update-read-articles
artgroup
- (gnus-uncompress-range
- (gnus-add-to-range
- (gnus-remove-from-range
+ (range-uncompress
+ (range-add-list
+ (range-remove
old-unread
(cdr (assoc artgroup select-reads)))
(sort (cdr (assoc artgroup select-unreads)) #'<))))
diff --git a/lisp/gnus/nnvirtual.el b/lisp/gnus/nnvirtual.el
index 7478a2dd0a..cc87a707ce 100644
--- a/lisp/gnus/nnvirtual.el
+++ b/lisp/gnus/nnvirtual.el
@@ -365,7 +365,7 @@ It is computed from the marks of individual component
groups.")
(lambda (article)
(nnvirtual-reverse-map-article
group article))
- (gnus-uncompress-range
+ (range-uncompress
(gnus-group-expire-articles-1 group))))))
(sort (delq nil unexpired) #'<)))
diff --git a/test/lisp/emacs-lisp/range-tests.el
b/test/lisp/emacs-lisp/range-tests.el
new file mode 100644
index 0000000000..d3abbf9da3
--- /dev/null
+++ b/test/lisp/emacs-lisp/range-tests.el
@@ -0,0 +1,65 @@
+;;; range-tests.el --- Tests for range.el -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2021 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;;
+
+;;; Code:
+
+(require 'range)
+(require 'ert)
+(require 'ert-x)
+
+(ert-deftest ranges ()
+ (should (equal (range-compress-list '(2 3 4 5 9 11 12 13))
+ '((2 . 5) 9 (11 . 13))))
+ (should (equal (range-uncompress '((2 . 5) 9 (11 . 13)))
+ '(2 3 4 5 9 11 12 13)))
+ (should (equal (range-normalize '(1 . 2))
+ '((1 . 2))))
+ (should (equal (range-difference '((1 . 10))
+ '((2 . 7)))
+ '(1 (8 . 10))))
+ (should (equal (range-intersection '((2 . 5) 9 (11 . 13))
+ '((5 . 12)))
+ '(5 9 (11 . 12))))
+ (should (equal (range-add-list '((2 . 5) 9 (11 . 13))
+ '(10 11 12 15 16 17))
+ '((2 . 5) (9 . 10) (11 . 13) (15 . 17))))
+ (should (equal (range-remove (copy-tree '((2 . 5) 9 (11 . 13)))
+ '((5 . 9)))
+ '((2 . 4) (11 . 13))))
+ (should (range-member-p 9 '((2 . 5) 9 (11 . 13))))
+ (should (range-member-p 12 '((2 . 5) 9 (11 . 13))))
+ (should (equal (range-list-intersection
+ '(4 5 6 7 8 9)
+ '((2 . 5) 9 (11 . 13)))
+ '(4 5 9)))
+ (should (equal (range-list-difference
+ '(4 5 6 7 8 9)
+ '((2 . 5) 9 (11 . 13)))
+ '(6 7 8)))
+ (should (equal (range-length '((2 . 5) 9 (11 . 13)))
+ 8))
+ (should (equal (range-concat '((2 . 5) 9 (11 . 13))
+ '(6 (12 . 15)))
+ '((2 . 6) 9 (11 . 15)))))
+
+;;; range-tests.el ends here