procyberian/emacs
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Move the Gnus range functions to a new range.el file

Browse source 
* 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):
This commit is contained in:
Lars Ingebrigtsen 2022-01-17 12:40:43 +01:00
parent ab17e35325
commit 39d4e1ca21
21 changed files with 705 additions and 562 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

467
lisp/emacs-lisp/range.el Normal file
View file

@ -0,0 +1,467 @@
;;; ranges.el --- range functions -*- lexical-binding: t; -*-
;; Copyright (C) 1996-2022 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; 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:
;; 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).
;;; Code:
(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 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 (range-normalize range1))
(setq range2 (range-normalize range2))
(let* ((new-range (cons nil (copy-sequence range1)))
(r new-range))
(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)))
(defun range-intersection (range1 range2)
"Return intersection of RANGE1 and RANGE2."
(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)))))
(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."
(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 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)
(range-compress-list list)
(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 (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 (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))))))
(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 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
(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 range-member-p (number ranges)
"Say whether NUMBER is in 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 range-list-intersection (list ranges)
"Return a list of numbers in LIST that are members of RANGES.
oLIST is a sorted list."
(setq ranges (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)))
(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 (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 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 range-concat (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)))
(defun range-map (func range)
"Apply FUNC to each value contained by RANGE."
(setq range (range-normalize range))
(while range
(let ((span (pop range)))
(if (numberp span)
(funcall func span)
(let ((first (car span))
(last (cdr span)))
(while (<= first last)
(funcall func first)
(setq first (1+ first))))))))
(provide 'range)
;;; range.el ends here

45
lisp/gnus/gnus-agent.el
View file

@ -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)))))

3
lisp/gnus/gnus-art.el
View file

@ -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)

3
lisp/gnus/gnus-cloud.el
View file

@ -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))

2
lisp/gnus/gnus-draft.el
View file

@ -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"))))))

52
lisp/gnus/gnus-group.el
View file

@ -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))

2
lisp/gnus/gnus-int.el
View file

@ -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))))))

2
lisp/gnus/gnus-kill.el
View file

@ -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))

433
lisp/gnus/gnus-range.el
View file

@ -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)))))
(define-obsolete-function-alias 'gnus-uncompress-range
#'range-uncompress "29.1")
(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)))
(define-obsolete-function-alias 'gnus-add-to-range
#'range-add-list "29.1")
(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))))
(define-obsolete-function-alias 'gnus-remove-from-range
#'range-remove "29.1")
(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))))
(define-obsolete-function-alias 'gnus-member-of-range #'range-member-p "29.1")
(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-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")
(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))))))))
(define-obsolete-function-alias 'gnus-range-length #'range-length "29.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)

14
lisp/gnus/gnus-start.el
View file

@ -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))

64
lisp/gnus/gnus-sum.el
View file

@ -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)

3
lisp/gnus/mail-source.el
View file

@ -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'.")

8
lisp/gnus/nnheader.el
View file

@ -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)))))

29
lisp/gnus/nnimap.el
View file

@ -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)

16
lisp/gnus/nnmaildir.el
View file

@ -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)

2
lisp/gnus/nnmairix.el
View file

@ -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))))

6
lisp/gnus/nnmbox.el
View file

@ -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))))

19
lisp/gnus/nnml.el
View file

@ -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))

30
lisp/gnus/nnselect.el
View file

@ -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)) #'<))))

2
lisp/gnus/nnvirtual.el
View file

@ -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) #'<)))

65
test/lisp/emacs-lisp/range-tests.el Normal file
View file

@ -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