* 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):
--- /dev/null
+;;; 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
(require 'gnus-srvr)
(require 'gnus-util)
(require 'timer)
+(require 'range)
(eval-when-compile (require 'cl-lib))
(autoload 'gnus-server-update-server "gnus-srvr")
(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
(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))))))))
(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))))))
(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)
;; 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
;; 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
(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)))
(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 #'<))
(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)
(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."
;; 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 #'<)))))
;; 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"))
(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)
;; 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)))
;; 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)))))
(require 'message)
(require 'mouse)
(require 'seq)
+(require 'range)
(autoload 'gnus-msg-mail "gnus-msg" nil t)
(autoload 'gnus-button-mailto "gnus-msg")
(setq sumkeys
(append (mapcar
#'vector
- (nreverse (gnus-uncompress-range def)))
+ (nreverse (range-uncompress def)))
sumkeys))))
((setq def (key-binding key))
(unless (eq def 'undefined)
(require 'parse-time)
(require 'nnimap)
+(require 'range)
(eval-when-compile (require 'epg)) ;; setf-method for `epg-context-armor'
(autoload 'epg-make-context "epg")
(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))
(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"))))))
(require 'gnus-undo)
(require 'gmm-utils)
(require 'time-date)
+(require 'range)
(eval-when-compile
(require 'mm-url)
((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)
?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)
(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
'(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)))
(- (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)))
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)))
'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)
(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))
(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))
(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))))))
(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))
;;; 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."
"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))
(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)
(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)
"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)
(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)
(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))
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."
(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))
;; (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
"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
(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)
(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))
;; 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)
;; 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)
;; 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))))
(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)
(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)
(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)
(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))
;; 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
(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))
;; 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)
(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))
(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)
(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)
(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'.")
;;; Code:
(eval-when-compile (require 'cl-lib))
+(require 'range)
(defvar gnus-decode-encoded-word-function)
(defvar gnus-decode-encoded-address-function)
(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")
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)))))
(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))
(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)))
(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
(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)))
(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))))
;; 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)))
(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)
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)
(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)))
(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
(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)
(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)
(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))))
;; 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))
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))))
;; #### 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))
(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
(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)
artids))
(t
(setq mark-list
- (gnus-uncompress-range mark-list))
+ (range-uncompress mark-list))
(mapcar
(lambda (id)
(when (memq (cdr id) mark-list)
(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))))
(< (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))
;; 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)) #'<))))
(lambda (article)
(nnvirtual-reverse-map-article
group article))
- (gnus-uncompress-range
+ (range-uncompress
(gnus-group-expire-articles-1 group))))))
(sort (delq nil unexpired) #'<)))
--- /dev/null
+;;; 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
projects / emacs.git / commitdiff