summaryrefslogtreecommitdiff
path: root/lisp/gnus
diff options
context:
space:
mode:
Diffstat (limited to 'lisp/gnus')
-rw-r--r--lisp/gnus/gnus-agent.el45
-rw-r--r--lisp/gnus/gnus-art.el64
-rw-r--r--lisp/gnus/gnus-cloud.el3
-rw-r--r--lisp/gnus/gnus-draft.el2
-rw-r--r--lisp/gnus/gnus-group.el52
-rw-r--r--lisp/gnus/gnus-int.el2
-rw-r--r--lisp/gnus/gnus-kill.el2
-rw-r--r--lisp/gnus/gnus-range.el443
-rw-r--r--lisp/gnus/gnus-start.el14
-rw-r--r--lisp/gnus/gnus-sum.el71
-rw-r--r--lisp/gnus/mail-source.el3
-rw-r--r--lisp/gnus/message.el19
-rw-r--r--lisp/gnus/mm-view.el2
-rw-r--r--lisp/gnus/nnheader.el8
-rw-r--r--lisp/gnus/nnimap.el29
-rw-r--r--lisp/gnus/nnmaildir.el16
-rw-r--r--lisp/gnus/nnmairix.el2
-rw-r--r--lisp/gnus/nnmbox.el6
-rw-r--r--lisp/gnus/nnml.el19
-rw-r--r--lisp/gnus/nnselect.el30
-rw-r--r--lisp/gnus/nnvirtual.el2
21 files changed, 252 insertions, 582 deletions
diff --git a/lisp/gnus/gnus-agent.el b/lisp/gnus/gnus-agent.el
index fd66135b5c6..e4704b35c8d 100644
--- a/lisp/gnus/gnus-agent.el
+++ b/lisp/gnus/gnus-agent.el
@@ -31,6 +31,7 @@
(require 'gnus-srvr)
(require 'gnus-util)
(require 'timer)
+(require 'range)
(eval-when-compile (require 'cl-lib))
(autoload 'gnus-server-update-server "gnus-srvr")
@@ -1219,8 +1220,8 @@ This can be added to `gnus-select-article-hook' or
(cond ((eq mark 'read)
(setf (gnus-info-read info)
(funcall (if (eq what 'add)
- #'gnus-range-add
- #'gnus-remove-from-range)
+ #'range-concat
+ #'range-remove)
(gnus-info-read info)
range))
(gnus-get-unread-articles-in-group
@@ -1233,8 +1234,8 @@ This can be added to `gnus-select-article-hook' or
(gnus-info-marks info)))
(setcdr info-marks
(funcall (if (eq what 'add)
- #'gnus-range-add
- #'gnus-remove-from-range)
+ #'range-concat
+ #'range-remove)
(cdr info-marks)
range))))))))
@@ -1307,7 +1308,7 @@ downloaded into the agent."
(let ((read (gnus-info-read info)))
(setf (gnus-info-read info)
- (gnus-range-add
+ (range-concat
read
(list (cons (1+ agent-max)
(1- active-min))))))
@@ -1796,13 +1797,13 @@ article numbers will be returned."
(articles (if fetch-all
(if gnus-newsgroup-maximum-articles
(let ((active (gnus-active group)))
- (gnus-uncompress-range
+ (range-uncompress
(cons (max (car active)
(- (cdr active)
gnus-newsgroup-maximum-articles
-1))
(cdr active))))
- (gnus-uncompress-range (gnus-active group)))
+ (range-uncompress (gnus-active group)))
(gnus-list-of-unread-articles group)))
(gnus-decode-encoded-word-function 'identity)
(gnus-decode-encoded-address-function 'identity)
@@ -1817,7 +1818,7 @@ article numbers will be returned."
;; because otherwise the agent will remove their marks.)
(dolist (arts (gnus-info-marks (gnus-get-info group)))
(unless (memq (car arts) '(seen recent killed cache))
- (setq articles (gnus-range-add articles (cdr arts)))))
+ (setq articles (range-concat articles (cdr arts)))))
(setq articles (sort (gnus-uncompress-sequence articles) #'<)))
;; At this point, I have the list of articles to consider for
@@ -1851,15 +1852,15 @@ article numbers will be returned."
;; gnus-agent-article-alist) equals (cdr (gnus-active
;; group))}. The addition of one(the 1+ above) then
;; forces Low to be greater than High. When this happens,
- ;; gnus-list-range-intersection returns nil which
+ ;; range-list-intersection returns nil which
;; indicates that no headers need to be fetched. -- Kevin
- (setq articles (gnus-list-range-intersection
+ (setq articles (range-list-intersection
articles (list (cons low high)))))))
(when articles
(gnus-message
10 "gnus-agent-fetch-headers: undownloaded articles are `%s'"
- (gnus-compress-sequence articles t)))
+ (range-compress-list articles)))
(with-current-buffer nntp-server-buffer
(if articles
@@ -2060,7 +2061,7 @@ doesn't exist, to valid the overview buffer."
(let (state sequence uncomp)
(while alist
(setq state (caar alist)
- sequence (inline (gnus-uncompress-range (cdar alist)))
+ sequence (inline (range-uncompress (cdar alist)))
alist (cdr alist))
(while sequence
(push (cons (pop sequence) state) uncomp)))
@@ -2404,7 +2405,7 @@ contents, they are first saved to their own file."
(let ((arts (cdr (assq mark (gnus-info-marks
(setq info (gnus-get-info group)))))))
(when arts
- (setq marked-articles (nconc (gnus-uncompress-range arts)
+ (setq marked-articles (nconc (range-uncompress arts)
marked-articles))
))))
(setq marked-articles (sort marked-articles #'<))
@@ -2544,7 +2545,7 @@ contents, they are first saved to their own file."
(let ((read (gnus-info-read
(or info (setq info (gnus-get-info group))))))
(setf (gnus-info-read info)
- (gnus-add-to-range read unfetched-articles)))
+ (range-add-list read unfetched-articles)))
(gnus-group-update-group group t)
(sit-for 0)
@@ -2898,8 +2899,8 @@ The following commands are available:
(defun gnus-agent-read-p ()
"Say whether an article is read or not."
- (gnus-member-of-range (mail-header-number gnus-headers)
- (gnus-info-read (gnus-get-info gnus-newsgroup-name))))
+ (range-member-p (mail-header-number gnus-headers)
+ (gnus-info-read (gnus-get-info gnus-newsgroup-name))))
(defun gnus-category-make-function (predicate)
"Make a function from PREDICATE."
@@ -3115,7 +3116,7 @@ FORCE is equivalent to setting the expiration predicates to true."
;; All articles EXCEPT those named by the caller
;; are protected from expiration
(gnus-sorted-difference
- (gnus-uncompress-range
+ (range-uncompress
(cons (caar alist)
(caar (last alist))))
(sort articles #'<)))))
@@ -3137,9 +3138,9 @@ FORCE is equivalent to setting the expiration predicates to true."
;; Ticked and/or dormant articles are excluded
;; from expiration
(nconc
- (gnus-uncompress-range
+ (range-uncompress
(cdr (assq 'tick (gnus-info-marks info))))
- (gnus-uncompress-range
+ (range-uncompress
(cdr (assq 'dormant
(gnus-info-marks info))))))))
(nov-file (concat dir ".overview"))
@@ -3638,7 +3639,7 @@ has been fetched."
(file-name-directory file) t))
(when fetch-old
- (setq articles (gnus-uncompress-range
+ (setq articles (range-uncompress
(cons (if (numberp fetch-old)
(max 1 (- (car articles) fetch-old))
1)
@@ -3694,7 +3695,7 @@ has been fetched."
;; Clip this list to the headers that will
;; actually be returned
- (setq fetched-articles (gnus-list-range-intersection
+ (setq fetched-articles (range-list-intersection
(cdr fetched-articles)
(cons min max)))
@@ -3703,7 +3704,7 @@ has been fetched."
;; excluded IDs may be fetchable using HEAD.
(if (car tail-fetched-articles)
(setq uncached-articles
- (gnus-list-range-intersection
+ (range-list-intersection
uncached-articles
(cons (car uncached-articles)
(car tail-fetched-articles)))))
diff --git a/lisp/gnus/gnus-art.el b/lisp/gnus/gnus-art.el
index a286c446724..9bb74e80857 100644
--- a/lisp/gnus/gnus-art.el
+++ b/lisp/gnus/gnus-art.el
@@ -42,6 +42,7 @@
(require 'message)
(require 'mouse)
(require 'seq)
+(require 'range)
(autoload 'gnus-msg-mail "gnus-msg" nil t)
(autoload 'gnus-button-mailto "gnus-msg")
@@ -1394,6 +1395,15 @@ predicate. See Info node `(gnus)Customizing Articles'."
:link '(custom-manual "(gnus)Customizing Articles")
:type gnus-article-treat-custom)
+(defcustom gnus-treat-suspicious-headers 'head
+ "Mark headers that are suspicious.
+Valid values are nil, t, `head', `first', `last', an integer or a
+predicate. See Info node `(gnus)Customizing Articles'."
+ :version "29.1"
+ :group 'gnus-article-treat
+ :link '(custom-manual "(gnus)Customizing Articles")
+ :type gnus-article-treat-custom)
+
(defcustom gnus-treat-fold-newsgroups 'head
"Fold the Newsgroups and Followup-To headers.
Valid values are nil, t, `head', `first', `last', an integer or a
@@ -1711,6 +1721,7 @@ regexp."
(gnus-treat-unfold-headers gnus-article-treat-unfold-headers)
(gnus-treat-fold-newsgroups gnus-article-treat-fold-newsgroups)
(gnus-treat-fold-headers gnus-article-treat-fold-headers)
+ (gnus-treat-suspicious-headers gnus-article-treat-suspicious-headers)
(gnus-treat-buttonize-head gnus-article-add-buttons-to-head)
(gnus-treat-display-smileys gnus-treat-smiley)
(gnus-treat-capitalize-sentences gnus-article-capitalize-sentences)
@@ -2235,6 +2246,20 @@ unfolded."
(pixel-fill-region (point) (point-max) (pixel-fill-width)))
(goto-char (point-max))))))
+(defun gnus-article-treat-suspicious-headers ()
+ "Mark suspicious headers."
+ (interactive nil gnus-article-mode gnus-summary-mode)
+ (gnus-with-article-headers
+ (let (match)
+ (while (setq match (text-property-search-forward 'textsec-suspicious))
+ (add-text-properties (prop-match-beginning match)
+ (prop-match-end match)
+ (list 'help-echo (prop-match-value match)
+ 'face 'textsec-suspicious))
+ (overlay-put (make-overlay (prop-match-end match)
+ (prop-match-end match))
+ 'after-string "⚠️")))))
+
(defun gnus-treat-smiley ()
"Toggle display of textual emoticons (\"smileys\") as small graphical icons."
(interactive nil gnus-article-mode gnus-summary-mode)
@@ -2611,17 +2636,36 @@ If PROMPT (the prefix), prompt for a coding system to use."
(forward-line -1))
(setq end (point))
(while (not (bobp))
- (while (progn
- (forward-line -1)
- (and (not (bobp))
- (memq (char-after) '(?\t ? )))))
- (setq start (point))
- (if (looking-at "\
+ (let (addresses)
+ (while (progn
+ (forward-line -1)
+ (and (not (bobp))
+ (memq (char-after) '(?\t ? )))))
+ (setq start (point))
+ (save-restriction
+ (narrow-to-region start end)
+ (if (looking-at "\
\\(?:Resent-\\)?\\(?:From\\|Cc\\|To\\|Bcc\\|\\(?:In-\\)?Reply-To\\|Sender\
\\|Mail-Followup-To\\|Mail-Copies-To\\|Approved\\):")
- (funcall gnus-decode-address-function start end)
- (funcall gnus-decode-header-function start end))
- (goto-char (setq end start)))))
+ (progn
+ (setq addresses (buffer-string))
+ (funcall gnus-decode-address-function (point-min) (point-max)))
+ (funcall gnus-decode-header-function (point-min) (point-max))))
+ (when addresses
+ (article--check-suspicious-addresses addresses))
+ (goto-char (point-max))
+ (goto-char (setq end start))))))
+
+(defun article--check-suspicious-addresses (addresses)
+ (setq addresses (replace-regexp-in-string "\\`[^:]+:[ \t\n]*" "" addresses))
+ (dolist (header (mail-header-parse-addresses addresses t))
+ (when-let* ((address (car (ignore-errors
+ (mail-header-parse-address header))))
+ (warning (textsec-suspicious-p address 'email-address)))
+ (goto-char (point-min))
+ (while (search-forward address nil t)
+ (put-text-property (match-beginning 0) (match-end 0)
+ 'textsec-suspicious warning)))))
(defun article-decode-group-name ()
"Decode group names in Newsgroups, Followup-To and Xref headers."
@@ -7019,7 +7063,7 @@ then we display only bindings that start with that prefix."
(setq sumkeys
(append (mapcar
#'vector
- (nreverse (gnus-uncompress-range def)))
+ (nreverse (range-uncompress def)))
sumkeys))))
((setq def (key-binding key))
(unless (eq def 'undefined)
diff --git a/lisp/gnus/gnus-cloud.el b/lisp/gnus/gnus-cloud.el
index 6ed9e32c919..9bd9f2155f7 100644
--- a/lisp/gnus/gnus-cloud.el
+++ b/lisp/gnus/gnus-cloud.el
@@ -30,6 +30,7 @@
(require 'parse-time)
(require 'nnimap)
+(require 'range)
(eval-when-compile (require 'epg)) ;; setf-method for `epg-context-armor'
(autoload 'epg-make-context "epg")
@@ -404,7 +405,7 @@ When FULL is t, upload everything, not just a difference from the last full."
(let* ((group (gnus-group-full-name gnus-cloud-group-name gnus-cloud-method))
(active (gnus-active group))
headers head)
- (when (gnus-retrieve-headers (gnus-uncompress-range active) group)
+ (when (gnus-retrieve-headers (range-uncompress active) group)
(with-current-buffer nntp-server-buffer
(goto-char (point-min))
(while (setq head (nnheader-parse-head))
diff --git a/lisp/gnus/gnus-draft.el b/lisp/gnus/gnus-draft.el
index cd9b025ff0e..56d498cc4d3 100644
--- a/lisp/gnus/gnus-draft.el
+++ b/lisp/gnus/gnus-draft.el
@@ -200,7 +200,7 @@ Obeys the standard process/prefix convention."
(gnus-activate-group "nndraft:queue")
(save-excursion
(let* ((articles (nndraft-articles))
- (unsendable (gnus-uncompress-range
+ (unsendable (range-uncompress
(cdr (assq 'unsend
(gnus-info-marks
(gnus-get-info "nndraft:queue"))))))
diff --git a/lisp/gnus/gnus-group.el b/lisp/gnus/gnus-group.el
index ab874dd0608..d3a94e9f4e0 100644
--- a/lisp/gnus/gnus-group.el
+++ b/lisp/gnus/gnus-group.el
@@ -35,6 +35,7 @@
(require 'gnus-undo)
(require 'gmm-utils)
(require 'time-date)
+(require 'range)
(eval-when-compile
(require 'mm-url)
@@ -512,8 +513,8 @@ simple manner."
((numberp number)
(int-to-string
(+ number
- (gnus-range-length (cdr (assq 'dormant gnus-tmp-marked)))
- (gnus-range-length (cdr (assq 'tick gnus-tmp-marked))))))
+ (range-length (cdr (assq 'dormant gnus-tmp-marked)))
+ (range-length (cdr (assq 'tick gnus-tmp-marked))))))
(t number))
?s)
(?R gnus-tmp-number-of-read ?s)
@@ -523,10 +524,10 @@ simple manner."
?s)
(?t gnus-tmp-number-total ?d)
(?y gnus-tmp-number-of-unread ?s)
- (?I (gnus-range-length (cdr (assq 'dormant gnus-tmp-marked))) ?d)
- (?T (gnus-range-length (cdr (assq 'tick gnus-tmp-marked))) ?d)
- (?i (+ (gnus-range-length (cdr (assq 'dormant gnus-tmp-marked)))
- (gnus-range-length (cdr (assq 'tick gnus-tmp-marked))))
+ (?I (range-length (cdr (assq 'dormant gnus-tmp-marked))) ?d)
+ (?T (range-length (cdr (assq 'tick gnus-tmp-marked))) ?d)
+ (?i (+ (range-length (cdr (assq 'dormant gnus-tmp-marked)))
+ (range-length (cdr (assq 'tick gnus-tmp-marked))))
?d)
(?g gnus-tmp-group ?s)
(?G gnus-tmp-qualified-group ?s)
@@ -1482,9 +1483,9 @@ if it is a string, only list groups matching REGEXP."
(active (gnus-active group)))
(if (not active)
0
- (length (gnus-uncompress-range
- (gnus-range-difference
- (gnus-range-difference (list active) (gnus-info-read info))
+ (length (range-uncompress
+ (range-difference
+ (range-difference (list active) (gnus-info-read info))
seen))))))
;; Moving through the Group buffer (in topic mode) e.g. with C-n doesn't
@@ -1642,7 +1643,7 @@ Some value are bound so the form can use them."
'(mail post-mail))))
(cons 'level (or (gnus-info-level info) gnus-level-killed))
(cons 'score (or (gnus-info-score info) 0))
- (cons 'ticked (gnus-range-length (cdr (assq 'tick marked))))
+ (cons 'ticked (range-length (cdr (assq 'tick marked))))
(cons 'group-age (gnus-group-timestamp-delta group)))))
(while (and list
(not (eval (caar list) env)))
@@ -2065,9 +2066,9 @@ that group."
(- (1+ (cdr active)) (car active)))))
(gnus-summary-read-group
group (or all (and (numberp number)
- (zerop (+ number (gnus-range-length
+ (zerop (+ number (range-length
(cdr (assq 'tick marked)))
- (gnus-range-length
+ (range-length
(cdr (assq 'dormant marked)))))))
no-article nil no-display nil select-articles)))
@@ -2832,7 +2833,7 @@ according to the expiry settings. Note that this will delete old
not-expirable articles, too."
(interactive (list (gnus-group-group-name) current-prefix-arg)
gnus-group-mode)
- (let ((articles (gnus-uncompress-range (gnus-active group))))
+ (let ((articles (range-uncompress (gnus-active group))))
(when (gnus-yes-or-no-p
(format "Do you really want to delete these %d articles forever? "
(length articles)))
@@ -3755,15 +3756,15 @@ or nil if no action could be taken."
'del '(tick))
(list (cdr (assq 'dormant marks))
'del '(dormant))))
- (setq unread (gnus-range-add (gnus-range-add
- unread (cdr (assq 'dormant marks)))
- (cdr (assq 'tick marks))))
+ (setq unread (range-concat (range-concat
+ unread (cdr (assq 'dormant marks)))
+ (cdr (assq 'tick marks))))
(gnus-add-marked-articles group 'tick nil nil 'force)
(gnus-add-marked-articles group 'dormant nil nil 'force))
;; Do auto-expirable marks if that's required.
(when (and (gnus-group-auto-expirable-p group)
(not (gnus-group-read-only-p group)))
- (gnus-range-map
+ (range-map
(lambda (article)
(gnus-add-marked-articles group 'expire (list article))
(gnus-request-set-mark group (list (list (list article)
@@ -3795,7 +3796,7 @@ Uses the process/prefix convention."
(cons nil (gnus-list-of-read-articles group))
(assq 'expire (gnus-info-marks info))))
(articles-to-expire
- (gnus-list-range-difference
+ (range-list-difference
(gnus-uncompress-sequence (cdr expirable))
(cdr (assq 'unexist (gnus-info-marks info)))))
(expiry-wait (gnus-group-find-parameter group 'expiry-wait))
@@ -4671,23 +4672,22 @@ and the second element is the address."
(and (not (setq marked (nthcdr 3 info)))
(or (null articles)
(setcdr (nthcdr 2 info)
- (list (list (cons type (gnus-compress-sequence
- articles t)))))))
+ (list (list (cons type (range-compress-list
+ articles)))))))
(and (not (setq m (assq type (car marked))))
(or (null articles)
(setcar marked
- (cons (cons type (gnus-compress-sequence articles t) )
+ (cons (cons type (range-compress-list articles))
(car marked)))))
(if force
(if (null articles)
(setcar (nthcdr 3 info)
(assq-delete-all type (car marked)))
- (setcdr m (gnus-compress-sequence articles t)))
- (setcdr m (gnus-compress-sequence
- (sort (nconc (gnus-uncompress-range (cdr m))
+ (setcdr m (range-compress-list articles)))
+ (setcdr m (range-compress-list
+ (sort (nconc (range-uncompress (cdr m))
(copy-sequence articles))
- #'<)
- t))))))
+ #'<)))))))
(declare-function gnus-summary-add-mark "gnus-sum" (article type))
diff --git a/lisp/gnus/gnus-int.el b/lisp/gnus/gnus-int.el
index 5a619e8f07b..f00f2a0d04e 100644
--- a/lisp/gnus/gnus-int.el
+++ b/lisp/gnus/gnus-int.el
@@ -802,7 +802,7 @@ If GROUP is nil, all groups on COMMAND-METHOD are scanned."
(when (> min 1)
(let* ((range (if (= min 2) 1 (cons 1 (1- min))))
(read (gnus-info-read info))
- (new-read (gnus-range-add read (list range))))
+ (new-read (range-concat read (list range))))
(setf (gnus-info-read info) new-read)))
info))))))
diff --git a/lisp/gnus/gnus-kill.el b/lisp/gnus/gnus-kill.el
index bee7860efdb..bc49f8385ea 100644
--- a/lisp/gnus/gnus-kill.el
+++ b/lisp/gnus/gnus-kill.el
@@ -349,7 +349,7 @@ Returns the number of articles marked as read."
(setq gnus-newsgroup-kill-headers
(mapcar #'mail-header-number headers))
(while headers
- (unless (gnus-member-of-range
+ (unless (range-member-p
(mail-header-number (car headers))
gnus-newsgroup-killed)
(push (mail-header-number (car headers))
diff --git a/lisp/gnus/gnus-range.el b/lisp/gnus/gnus-range.el
index da3ff473725..23a71bda209 100644
--- a/lisp/gnus/gnus-range.el
+++ b/lisp/gnus/gnus-range.el
@@ -26,10 +26,8 @@
;;; List and range functions
-(defsubst gnus-range-normalize (range)
- "Normalize RANGE.
-If RANGE is a single range, return (RANGE). Otherwise, return RANGE."
- (if (listp (cdr-safe range)) range (list range)))
+(require 'range)
+(define-obsolete-function-alias 'gnus-range-normalize #'range-normalize "29.1")
(defun gnus-last-element (list)
"Return last element of LIST."
@@ -56,10 +54,10 @@ If RANGE is a single range, return (RANGE). Otherwise, return RANGE."
"Return a range comprising all the RANGES, which are pre-sorted.
RANGES will be destructively altered."
(setq ranges (delete nil ranges))
- (let* ((result (gnus-range-normalize (pop ranges)))
+ (let* ((result (range-normalize (pop ranges)))
(last (last result)))
(dolist (range ranges)
- (setq range (gnus-range-normalize range))
+ (setq range (range-normalize range))
;; Normalize the single-number case, so that we don't need to
;; special-case that so much.
(when (numberp (car last))
@@ -82,47 +80,8 @@ RANGES will be destructively altered."
(car result)
result)))
-(defun gnus-range-difference (range1 range2)
- "Return the range of elements in RANGE1 that do not appear in RANGE2.
-Both ranges must be in ascending order."
- (setq range1 (gnus-range-normalize range1))
- (setq range2 (gnus-range-normalize range2))
- (let* ((new-range (cons nil (copy-sequence range1)))
- (r new-range)
- ) ;; (safe t)
- (while (cdr r)
- (let* ((r1 (cadr r))
- (r2 (car range2))
- (min1 (if (numberp r1) r1 (car r1)))
- (max1 (if (numberp r1) r1 (cdr r1)))
- (min2 (if (numberp r2) r2 (car r2)))
- (max2 (if (numberp r2) r2 (cdr r2))))
-
- (cond ((> min1 max1)
- ;; Invalid range: may result from overlap condition (below)
- ;; remove Invalid range
- (setcdr r (cddr r)))
- ((and (= min1 max1)
- (listp r1))
- ;; Inefficient representation: may result from overlap condition (below)
- (setcar (cdr r) min1))
- ((not min2)
- ;; All done with range2
- (setq r nil))
- ((< max1 min2)
- ;; No overlap: range1 precedes range2
- (pop r))
- ((< max2 min1)
- ;; No overlap: range2 precedes range1
- (pop range2))
- ((and (<= min2 min1) (<= max1 max2))
- ;; Complete overlap: range1 removed
- (setcdr r (cddr r)))
- (t
- (setcdr r (nconc (list (cons min1 (1- min2)) (cons (1+ max2) max1)) (cddr r)))))))
- (cdr new-range)))
-
-
+(define-obsolete-function-alias 'gnus-range-difference
+ #'range-difference "29.1")
;;;###autoload
(defun gnus-sorted-difference (list1 list2)
@@ -200,57 +159,8 @@ LIST1 and LIST2 have to be sorted over <."
(setq list2 (cdr list2)))))
(nreverse out)))
-;;;###autoload
-(defun gnus-sorted-range-intersection (range1 range2)
- "Return intersection of RANGE1 and RANGE2.
-RANGE1 and RANGE2 have to be sorted over <."
- (let* (out
- (min1 (car range1))
- (max1 (if (numberp min1)
- (if (numberp (cdr range1))
- (prog1 (cdr range1)
- (setq range1 nil)) min1)
- (prog1 (cdr min1)
- (setq min1 (car min1)))))
- (min2 (car range2))
- (max2 (if (numberp min2)
- (if (numberp (cdr range2))
- (prog1 (cdr range2)
- (setq range2 nil)) min2)
- (prog1 (cdr min2)
- (setq min2 (car min2))))))
- (setq range1 (cdr range1)
- range2 (cdr range2))
- (while (and min1 min2)
- (cond ((< max1 min2) ; range1 precedes range2
- (setq range1 (cdr range1)
- min1 nil))
- ((< max2 min1) ; range2 precedes range1
- (setq range2 (cdr range2)
- min2 nil))
- (t ; some sort of overlap is occurring
- (let ((min (max min1 min2))
- (max (min max1 max2)))
- (setq out (if (= min max)
- (cons min out)
- (cons (cons min max) out))))
- (if (< max1 max2) ; range1 ends before range2
- (setq min1 nil) ; incr range1
- (setq min2 nil)))) ; incr range2
- (unless min1
- (setq min1 (car range1)
- max1 (if (numberp min1) min1 (prog1 (cdr min1) (setq min1 (car min1))))
- range1 (cdr range1)))
- (unless min2
- (setq min2 (car range2)
- max2 (if (numberp min2) min2 (prog1 (cdr min2) (setq min2 (car min2))))
- range2 (cdr range2))))
- (cond ((cdr out)
- (nreverse out))
- ((numberp (car out))
- out)
- (t
- (car out)))))
+(define-obsolete-function-alias 'gnus-sorted-range-intersection
+ #'range-intersection "29.1")
;;;###autoload
(defalias 'gnus-set-sorted-intersection 'gnus-sorted-nintersection)
@@ -327,315 +237,33 @@ LIST1 and LIST2 have to be sorted over <."
"Convert sorted list of numbers to a list of ranges or a single range.
If ALWAYS-LIST is non-nil, this function will always release a list of
ranges."
- (let* ((first (car numbers))
- (last (car numbers))
- result)
- (if (null numbers)
- nil
- (if (not (listp (cdr numbers)))
- numbers
- (while numbers
- (cond ((= last (car numbers)) nil) ;Omit duplicated number
- ((= (1+ last) (car numbers)) ;Still in sequence
- (setq last (car numbers)))
- (t ;End of one sequence
- (setq result
- (cons (if (= first last) first
- (cons first last))
- result))
- (setq first (car numbers))
- (setq last (car numbers))))
- (setq numbers (cdr numbers)))
- (if (and (not always-list) (null result))
- (if (= first last) (list first) (cons first last))
- (nreverse (cons (if (= first last) first (cons first last))
- result)))))))
+ (if always-list
+ (range-compress-list numbers)
+ (range-denormalize (range-compress-list numbers))))
(defalias 'gnus-uncompress-sequence 'gnus-uncompress-range)
-(defun gnus-uncompress-range (ranges)
- "Expand a list of ranges into a list of numbers.
-RANGES is either a single range on the form `(num . num)' or a list of
-these ranges."
- (let (first last result)
- (cond
- ((null ranges)
- nil)
- ((not (listp (cdr ranges)))
- (setq first (car ranges))
- (setq last (cdr ranges))
- (while (<= first last)
- (setq result (cons first result))
- (setq first (1+ first)))
- (nreverse result))
- (t
- (while ranges
- (if (atom (car ranges))
- (when (numberp (car ranges))
- (setq result (cons (car ranges) result)))
- (setq first (caar ranges))
- (setq last (cdar ranges))
- (while (<= first last)
- (setq result (cons first result))
- (setq first (1+ first))))
- (setq ranges (cdr ranges)))
- (nreverse result)))))
-
-(defun gnus-add-to-range (ranges list)
- "Return a list of ranges that has all articles from both RANGES and LIST.
-Note: LIST has to be sorted over `<'."
- (if (not ranges)
- (gnus-compress-sequence list t)
- (setq list (copy-sequence list))
- (unless (listp (cdr ranges))
- (setq ranges (list ranges)))
- (let ((out ranges)
- ilist lowest highest temp)
- (while (and ranges list)
- (setq ilist list)
- (setq lowest (or (and (atom (car ranges)) (car ranges))
- (caar ranges)))
- (while (and list (cdr list) (< (cadr list) lowest))
- (setq list (cdr list)))
- (when (< (car ilist) lowest)
- (setq temp list)
- (setq list (cdr list))
- (setcdr temp nil)
- (setq out (nconc (gnus-compress-sequence ilist t) out)))
- (setq highest (or (and (atom (car ranges)) (car ranges))
- (cdar ranges)))
- (while (and list (<= (car list) highest))
- (setq list (cdr list)))
- (setq ranges (cdr ranges)))
- (when list
- (setq out (nconc (gnus-compress-sequence list t) out)))
- (setq out (sort out (lambda (r1 r2)
- (< (or (and (atom r1) r1) (car r1))
- (or (and (atom r2) r2) (car r2))))))
- (setq ranges out)
- (while ranges
- (if (atom (car ranges))
- (when (cdr ranges)
- (if (atom (cadr ranges))
- (when (= (1+ (car ranges)) (cadr ranges))
- (setcar ranges (cons (car ranges)
- (cadr ranges)))
- (setcdr ranges (cddr ranges)))
- (when (= (1+ (car ranges)) (caadr ranges))
- (setcar (cadr ranges) (car ranges))
- (setcar ranges (cadr ranges))
- (setcdr ranges (cddr ranges)))))
- (when (cdr ranges)
- (if (atom (cadr ranges))
- (when (= (1+ (cdar ranges)) (cadr ranges))
- (setcdr (car ranges) (cadr ranges))
- (setcdr ranges (cddr ranges)))
- (when (= (1+ (cdar ranges)) (caadr ranges))
- (setcdr (car ranges) (cdadr ranges))
- (setcdr ranges (cddr ranges))))))
- (setq ranges (cdr ranges)))
- out)))
-
-(defun gnus-remove-from-range (range1 range2)
- "Return a range that has all articles from RANGE2 removed from RANGE1.
-The returned range is always a list. RANGE2 can also be a unsorted
-list of articles. RANGE1 is modified by side effects, RANGE2 is not
-modified."
- (if (or (null range1) (null range2))
- range1
- (let (out r1 r2 r1_min r1_max r2_min r2_max
- (range2 (copy-tree range2)))
- (setq range1 (if (listp (cdr range1)) range1 (list range1))
- range2 (sort (if (listp (cdr range2)) range2 (list range2))
- (lambda (e1 e2)
- (< (if (consp e1) (car e1) e1)
- (if (consp e2) (car e2) e2))))
- r1 (car range1)
- r2 (car range2)
- r1_min (if (consp r1) (car r1) r1)
- r1_max (if (consp r1) (cdr r1) r1)
- r2_min (if (consp r2) (car r2) r2)
- r2_max (if (consp r2) (cdr r2) r2))
- (while (and range1 range2)
- (cond ((< r2_max r1_min) ; r2 < r1
- (pop range2)
- (setq r2 (car range2)
- r2_min (if (consp r2) (car r2) r2)
- r2_max (if (consp r2) (cdr r2) r2)))
- ((and (<= r2_min r1_min) (<= r1_max r2_max)) ; r2 overlap r1
- (pop range1)
- (setq r1 (car range1)
- r1_min (if (consp r1) (car r1) r1)
- r1_max (if (consp r1) (cdr r1) r1)))
- ((and (<= r2_min r1_min) (<= r2_max r1_max)) ; r2 overlap min r1
- (pop range2)
- (setq r1_min (1+ r2_max)
- r2 (car range2)
- r2_min (if (consp r2) (car r2) r2)
- r2_max (if (consp r2) (cdr r2) r2)))
- ((and (<= r1_min r2_min) (<= r2_max r1_max)) ; r2 contained in r1
- (if (eq r1_min (1- r2_min))
- (push r1_min out)
- (push (cons r1_min (1- r2_min)) out))
- (pop range2)
- (if (< r2_max r1_max) ; finished with r1?
- (setq r1_min (1+ r2_max))
- (pop range1)
- (setq r1 (car range1)
- r1_min (if (consp r1) (car r1) r1)
- r1_max (if (consp r1) (cdr r1) r1)))
- (setq r2 (car range2)
- r2_min (if (consp r2) (car r2) r2)
- r2_max (if (consp r2) (cdr r2) r2)))
- ((and (<= r2_min r1_max) (<= r1_max r2_max)) ; r2 overlap max r1
- (if (eq r1_min (1- r2_min))
- (push r1_min out)
- (push (cons r1_min (1- r2_min)) out))
- (pop range1)
- (setq r1 (car range1)
- r1_min (if (consp r1) (car r1) r1)
- r1_max (if (consp r1) (cdr r1) r1)))
- ((< r1_max r2_min) ; r2 > r1
- (pop range1)
- (if (eq r1_min r1_max)
- (push r1_min out)
- (push (cons r1_min r1_max) out))
- (setq r1 (car range1)
- r1_min (if (consp r1) (car r1) r1)
- r1_max (if (consp r1) (cdr r1) r1)))))
- (when r1
- (if (eq r1_min r1_max)
- (push r1_min out)
- (push (cons r1_min r1_max) out))
- (pop range1))
- (while range1
- (push (pop range1) out))
- (nreverse out))))
-
-(defun gnus-member-of-range (number ranges)
- (if (not (listp (cdr ranges)))
- (and (>= number (car ranges))
- (<= number (cdr ranges)))
- (let ((not-stop t))
- (while (and ranges
- (if (numberp (car ranges))
- (>= number (car ranges))
- (>= number (caar ranges)))
- not-stop)
- (when (if (numberp (car ranges))
- (= number (car ranges))
- (and (>= number (caar ranges))
- (<= number (cdar ranges))))
- (setq not-stop nil))
- (setq ranges (cdr ranges)))
- (not not-stop))))
-
-(defun gnus-list-range-intersection (list ranges)
- "Return a list of numbers in LIST that are members of RANGES.
-LIST is a sorted list."
- (setq ranges (gnus-range-normalize ranges))
- (let (number result)
- (while (setq number (pop list))
- (while (and ranges
- (if (numberp (car ranges))
- (< (car ranges) number)
- (< (cdar ranges) number)))
- (setq ranges (cdr ranges)))
- (when (and ranges
- (if (numberp (car ranges))
- (= (car ranges) number)
- ;; (caar ranges) <= number <= (cdar ranges)
- (>= number (caar ranges))))
- (push number result)))
- (nreverse result)))
+(define-obsolete-function-alias 'gnus-uncompress-range
+ #'range-uncompress "29.1")
+
+(define-obsolete-function-alias 'gnus-add-to-range
+ #'range-add-list "29.1")
+
+(define-obsolete-function-alias 'gnus-remove-from-range
+ #'range-remove "29.1")
+
+(define-obsolete-function-alias 'gnus-member-of-range #'range-member-p "29.1")
+
+(define-obsolete-function-alias 'gnus-list-range-intersection
+ #'range-list-intersection "29.1")
(defalias 'gnus-inverse-list-range-intersection 'gnus-list-range-difference)
-(defun gnus-list-range-difference (list ranges)
- "Return a list of numbers in LIST that are not members of RANGES.
-LIST is a sorted list."
- (setq ranges (gnus-range-normalize ranges))
- (let (number result)
- (while (setq number (pop list))
- (while (and ranges
- (if (numberp (car ranges))
- (< (car ranges) number)
- (< (cdar ranges) number)))
- (setq ranges (cdr ranges)))
- (when (or (not ranges)
- (if (numberp (car ranges))
- (not (= (car ranges) number))
- ;; not ((caar ranges) <= number <= (cdar ranges))
- (< number (caar ranges))))
- (push number result)))
- (nreverse result)))
+(define-obsolete-function-alias 'gnus-list-range-difference
+ #'range-list-difference "29.1")
+
+(define-obsolete-function-alias 'gnus-range-length #'range-length "29.1")
-(defun gnus-range-length (range)
- "Return the length RANGE would have if uncompressed."
- (cond
- ((null range)
- 0)
- ((not (listp (cdr range)))
- (- (cdr range) (car range) -1))
- (t
- (let ((sum 0))
- (dolist (x range sum)
- (setq sum
- (+ sum (if (consp x) (- (cdr x) (car x) -1) 1))))))))
-
-(defun gnus-range-add (range1 range2)
- "Add RANGE2 to RANGE1 (nondestructively)."
- (unless (listp (cdr range1))
- (setq range1 (list range1)))
- (unless (listp (cdr range2))
- (setq range2 (list range2)))
- (let ((item1 (pop range1))
- (item2 (pop range2))
- range item selector)
- (while (or item1 item2)
- (setq selector
- (cond
- ((null item1) nil)
- ((null item2) t)
- ((and (numberp item1) (numberp item2)) (< item1 item2))
- ((numberp item1) (< item1 (car item2)))
- ((numberp item2) (< (car item1) item2))
- (t (< (car item1) (car item2)))))
- (setq item
- (or
- (let ((tmp1 item) (tmp2 (if selector item1 item2)))
- (cond
- ((null tmp1) tmp2)
- ((null tmp2) tmp1)
- ((and (numberp tmp1) (numberp tmp2))
- (cond
- ((eq tmp1 tmp2) tmp1)
- ((eq (1+ tmp1) tmp2) (cons tmp1 tmp2))
- ((eq (1+ tmp2) tmp1) (cons tmp2 tmp1))
- (t nil)))
- ((numberp tmp1)
- (cond
- ((and (>= tmp1 (car tmp2)) (<= tmp1 (cdr tmp2))) tmp2)
- ((eq (1+ tmp1) (car tmp2)) (cons tmp1 (cdr tmp2)))
- ((eq (1- tmp1) (cdr tmp2)) (cons (car tmp2) tmp1))
- (t nil)))
- ((numberp tmp2)
- (cond
- ((and (>= tmp2 (car tmp1)) (<= tmp2 (cdr tmp1))) tmp1)
- ((eq (1+ tmp2) (car tmp1)) (cons tmp2 (cdr tmp1)))
- ((eq (1- tmp2) (cdr tmp1)) (cons (car tmp1) tmp2))
- (t nil)))
- ((< (1+ (cdr tmp1)) (car tmp2)) nil)
- ((< (1+ (cdr tmp2)) (car tmp1)) nil)
- (t (cons (min (car tmp1) (car tmp2))
- (max (cdr tmp1) (cdr tmp2))))))
- (progn
- (if item (push item range))
- (if selector item1 item2))))
- (if selector
- (setq item1 (pop range1))
- (setq item2 (pop range2))))
- (if item (push item range))
- (reverse range)))
+(define-obsolete-function-alias 'gnus-range-add #'range-concat "29.1")
;;;###autoload
(defun gnus-add-to-sorted-list (list num)
@@ -649,18 +277,7 @@ LIST is a sorted list."
(setcdr prev (cons num list)))
(cdr top)))
-(defun gnus-range-map (func range)
- "Apply FUNC to each value contained by RANGE."
- (setq range (gnus-range-normalize range))
- (while range
- (let ((span (pop range)))
- (if (numberp span)
- (funcall func span)
- (let ((first (car span))
- (last (cdr span)))
- (while (<= first last)
- (funcall func first)
- (setq first (1+ first))))))))
+(define-obsolete-function-alias 'gnus-range-map #'range-map "29.1")
(provide 'gnus-range)
diff --git a/lisp/gnus/gnus-start.el b/lisp/gnus/gnus-start.el
index 252e6e22299..2cf11fb12f9 100644
--- a/lisp/gnus/gnus-start.el
+++ b/lisp/gnus/gnus-start.el
@@ -1884,13 +1884,12 @@ The info element is shared with the same element of
(ranges (gnus-info-read info))
news article)
(while articles
- (when (gnus-member-of-range
- (setq article (pop articles)) ranges)
+ (when (range-member-p (setq article (pop articles)) ranges)
(push article news)))
(when news
;; Enter this list into the group info.
(setf (gnus-info-read info)
- (gnus-remove-from-range (gnus-info-read info) (nreverse news)))
+ (range-remove (gnus-info-read info) (nreverse news)))
;; Set the number of unread articles in gnus-newsrc-hashtb.
(gnus-get-unread-articles-in-group info (gnus-active group))
@@ -2362,10 +2361,10 @@ The form should return either t or nil."
ticked (cdr (assq 'tick marks)))
(when (or dormant ticked)
(setf (gnus-info-read info)
- (gnus-add-to-range
+ (range-add-list
(gnus-info-read info)
- (nconc (gnus-uncompress-range dormant)
- (gnus-uncompress-range ticked)))))))))
+ (nconc (range-uncompress dormant)
+ (range-uncompress ticked)))))))))
(defun gnus-load (file)
"Load FILE, but in such a way that read errors can be reported."
@@ -2457,8 +2456,7 @@ The form should return either t or nil."
(unless (nthcdr 3 info)
(nconc info (list nil)))
(setf (gnus-info-marks info)
- (list (cons 'tick (gnus-compress-sequence
- (sort (cdr m) #'<) t))))))
+ (list (cons 'tick (range-compress-list (sort (cdr m) #'<)))))))
(setq newsrc killed)
(while newsrc
(setcar newsrc (caar newsrc))
diff --git a/lisp/gnus/gnus-sum.el b/lisp/gnus/gnus-sum.el
index d3e476b5d64..8fb07d5905c 100644
--- a/lisp/gnus/gnus-sum.el
+++ b/lisp/gnus/gnus-sum.el
@@ -5755,7 +5755,7 @@ If SELECT-ARTICLES, only select those articles from GROUP."
;; (let ((n (cdr (gnus-active group))))
;; (lambda () (> number (- n display))))
(setq select-articles
- (gnus-uncompress-range
+ (range-uncompress
(cons (let ((tmp (- (cdr (gnus-active group)) display)))
(if (> tmp 0)
tmp
@@ -5928,7 +5928,7 @@ If SELECT-ARTICLES, only select those articles from GROUP."
"Find out what articles the user wants to read."
(let* ((only-read-p t)
(articles
- (gnus-list-range-difference
+ (range-list-difference
;; Select all articles if `read-all' is non-nil, or if there
;; are no unread articles.
(if (or read-all
@@ -5943,13 +5943,13 @@ If SELECT-ARTICLES, only select those articles from GROUP."
(or
(if gnus-newsgroup-maximum-articles
(let ((active (gnus-active group)))
- (gnus-uncompress-range
+ (range-uncompress
(cons (max (car active)
(- (cdr active)
gnus-newsgroup-maximum-articles
-1))
(cdr active))))
- (gnus-uncompress-range (gnus-active group)))
+ (range-uncompress (gnus-active group)))
(gnus-cache-articles-in-group group))
;; Select only the "normal" subset of articles.
(setq only-read-p nil)
@@ -6040,7 +6040,7 @@ If SELECT-ARTICLES, only select those articles from GROUP."
(defun gnus-killed-articles (killed articles)
(let (out)
(while articles
- (when (inline (gnus-member-of-range (car articles) killed))
+ (when (inline (range-member-p (car articles) killed))
(push (car articles) out))
(setq articles (cdr articles)))
out))
@@ -6078,7 +6078,7 @@ If SELECT-ARTICLES, only select those articles from GROUP."
;; Adjust "simple" lists - compressed yet unsorted
((eq mark-type 'list)
;; Simultaneously uncompress and clip to active range
- ;; See gnus-uncompress-range for a description of possible marks
+ ;; See range-uncompress for a description of possible marks
(let (l lh)
(if (not (cadr marks))
(set var nil)
@@ -6177,10 +6177,10 @@ If SELECT-ARTICLES, only select those articles from GROUP."
;; When exiting the group, everything that's previously been
;; unseen is now seen.
(when (eq (cdr type) 'seen)
- (setq list (gnus-range-add list gnus-newsgroup-unseen)))
+ (setq list (range-concat list gnus-newsgroup-unseen)))
(when (eq (gnus-article-mark-to-type (cdr type)) 'list)
- (setq list (gnus-compress-sequence (set symbol (sort list #'<)) t)))
+ (setq list (range-compress-list (set symbol (sort list #'<)))))
(when (and (gnus-check-backend-function
'request-set-mark gnus-newsgroup-name)
@@ -6189,20 +6189,19 @@ If SELECT-ARTICLES, only select those articles from GROUP."
;; Don't do anything about marks for articles we
;; didn't actually get any headers for.
(del
- (gnus-list-range-intersection
+ (range-list-intersection
gnus-newsgroup-articles
- (gnus-remove-from-range (copy-tree old) list)))
+ (range-remove (copy-tree old) list)))
(add
- (gnus-list-range-intersection
+ (range-list-intersection
gnus-newsgroup-articles
- (gnus-remove-from-range
- (copy-tree list) old))))
+ (range-remove (copy-tree list) old))))
(when add
(push (list add 'add (list (cdr type))) delta-marks))
(when del
;; Don't delete marks from outside the active range.
;; This shouldn't happen, but is a sanity check.
- (setq del (gnus-sorted-range-intersection
+ (setq del (range-intersection
(gnus-active gnus-newsgroup-name) del))
(push (list del 'del (list (cdr type))) delta-marks))))
@@ -6386,7 +6385,7 @@ The resulting hash table is returned, or nil if no Xrefs were found."
(setq ninfo (cons 1 (1- (car active))))
(setq ninfo (gnus-info-read info)))
;; Then we add the read articles to the range.
- (gnus-add-to-range
+ (range-add-list
ninfo (setq articles (sort articles #'<))))))
(defun gnus-group-make-articles-read (group articles)
@@ -6967,10 +6966,10 @@ displayed, no centering will be performed."
(marked (gnus-info-marks info))
(active (gnus-active group)))
(and info active
- (gnus-list-range-difference
- (gnus-list-range-difference
+ (range-list-difference
+ (range-list-difference
(gnus-sorted-complement
- (gnus-uncompress-range
+ (range-uncompress
(if gnus-newsgroup-maximum-articles
(cons (max (car active)
(- (cdr active)
@@ -7129,12 +7128,11 @@ The prefix argument ALL means to select all articles."
(when group
(when gnus-newsgroup-kill-headers
(setq gnus-newsgroup-killed
- (gnus-compress-sequence
+ (range-compress-list
(gnus-sorted-union
- (gnus-list-range-intersection
+ (range-list-intersection
gnus-newsgroup-unselected gnus-newsgroup-killed)
- gnus-newsgroup-unreads)
- t)))
+ gnus-newsgroup-unreads))))
(unless (listp (cdr gnus-newsgroup-killed))
(setq gnus-newsgroup-killed (list gnus-newsgroup-killed)))
(let ((headers gnus-newsgroup-headers)
@@ -10241,8 +10239,8 @@ ACTION can be either `move' (the default), `crosspost' or `copy'."
(cdr art-group))
(push 'read to-marks)
(setf (gnus-info-read info)
- (gnus-add-to-range (gnus-info-read info)
- (list (cdr art-group)))))
+ (range-add-list (gnus-info-read info)
+ (list (cdr art-group)))))
;; See whether the article is to be put in the cache.
(let* ((expirable (gnus-group-auto-expirable-p to-group))
@@ -10525,7 +10523,7 @@ This will be the case if the article has both been mailed and posted."
;; This backend supports expiry.
(let* ((total (gnus-group-total-expirable-p gnus-newsgroup-name))
(expirable
- (gnus-list-range-difference
+ (range-list-difference
(if total
(progn
;; We need to update the info for
@@ -11898,7 +11896,8 @@ Returns nil if no threads were there to be hidden."
(beginning-of-line)
(let ((start (point))
(starteol (line-end-position))
- (article (gnus-summary-article-number)))
+ (article (unless (gnus-summary-article-intangible-p)
+ (gnus-summary-article-number))))
;; Go forward until either the buffer ends or the subthread ends.
(when (and (not (eobp))
(or (zerop (gnus-summary-next-thread 1 t))
@@ -11912,7 +11911,9 @@ Returns nil if no threads were there to be hidden."
(let ((ol (make-overlay starteol (point) nil t nil)))
(overlay-put ol 'invisible 'gnus-sum)
(overlay-put ol 'evaporate t)))
- (gnus-summary-goto-subject article)
+ (if article
+ (gnus-summary-goto-subject article)
+ (gnus-summary-position-point))
;; We moved backward past the start point (invisible thread?)
(when (> start (point))
(goto-char starteol)))
@@ -12871,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))
@@ -13130,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)
@@ -13150,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))
@@ -13187,7 +13188,7 @@ If ALL is a number, fetch this number of articles."
(push max older)
(setq all (1- all)
max (1- max))))))))))
- (setq older (gnus-uncompress-range older))))
+ (setq older (range-uncompress older))))
(if (not older)
(message "No old news.")
(gnus-summary-insert-articles older)
diff --git a/lisp/gnus/mail-source.el b/lisp/gnus/mail-source.el
index 9a48f710e55..5d0c0e2654b 100644
--- a/lisp/gnus/mail-source.el
+++ b/lisp/gnus/mail-source.el
@@ -31,6 +31,7 @@
(autoload 'pop3-movemail "pop3")
(autoload 'pop3-get-message-count "pop3")
(require 'mm-util)
+(require 'gnus-range)
(require 'message) ;; for `message-directory'
(defvar display-time-mail-function)
@@ -1048,8 +1049,6 @@ This only works when `display-time' is enabled."
(autoload 'imap-range-to-message-set "imap")
(autoload 'nnheader-ms-strip-cr "nnheader")
-(autoload 'gnus-compress-sequence "gnus-range")
-
(defvar mail-source-imap-file-coding-system 'binary
"Coding system for the crashbox made by `mail-source-fetch-imap'.")
diff --git a/lisp/gnus/message.el b/lisp/gnus/message.el
index 8f11e538c5a..a6c6a16653d 100644
--- a/lisp/gnus/message.el
+++ b/lisp/gnus/message.el
@@ -4357,7 +4357,11 @@ it is left unchanged."
(defun message-update-smtp-method-header ()
"Insert an X-Message-SMTP-Method header according to `message-server-alist'."
(unless (message-fetch-field "X-Message-SMTP-Method")
- (let ((from (cadr (mail-extract-address-components (message-fetch-field "From"))))
+ (let ((from (cadr (mail-extract-address-components
+ (save-restriction
+ (widen)
+ (message-narrow-to-headers-or-head)
+ (message-fetch-field "From")))))
method)
(catch 'exit
(dolist (server message-server-alist)
@@ -4901,7 +4905,18 @@ If you always want Gnus to send messages in one piece, set
(message-generate-headers '(Lines)))
;; Remove some headers.
(message-remove-header message-ignored-mail-headers t)
- (mail-encode-encoded-word-buffer))
+ (mail-encode-encoded-word-buffer)
+ ;; Then check for suspicious addresses.
+ (dolist (hdr '("To" "Cc" "Bcc"))
+ (let ((addr (message-fetch-field hdr)))
+ (when (stringp addr)
+ (dolist (address (mail-header-parse-addresses addr t))
+ (when-let ((warning (textsec-suspicious-p
+ address 'email-address-header)))
+ (unless (y-or-n-p
+ (format "Suspicious address: %s; send anyway?"
+ warning))
+ (user-error "Suspicious address %s" address))))))))
(goto-char (point-max))
;; require one newline at the end.
(or (= (preceding-char) ?\n)
diff --git a/lisp/gnus/mm-view.el b/lisp/gnus/mm-view.el
index b110750c098..c40c38a95f9 100644
--- a/lisp/gnus/mm-view.el
+++ b/lisp/gnus/mm-view.el
@@ -504,8 +504,6 @@ If MODE is not set, try to find mode automatically."
(setq coding-system (mm-find-buffer-file-coding-system)))
(setq text (buffer-string))))
(with-temp-buffer
- (buffer-disable-undo)
- (mm-enable-multibyte)
(insert (cond ((eq charset 'gnus-decoded)
(with-current-buffer (mm-handle-buffer handle)
(buffer-string)))
diff --git a/lisp/gnus/nnheader.el b/lisp/gnus/nnheader.el
index 8b3718ed7e8..c1c5f00ff7f 100644
--- a/lisp/gnus/nnheader.el
+++ b/lisp/gnus/nnheader.el
@@ -27,6 +27,7 @@
;;; Code:
(eval-when-compile (require 'cl-lib))
+(require 'range)
(defvar gnus-decode-encoded-word-function)
(defvar gnus-decode-encoded-address-function)
@@ -44,8 +45,6 @@
(require 'mm-util)
(require 'gnus-util)
(autoload 'gnus-remove-odd-characters "gnus-sum")
-(autoload 'gnus-range-add "gnus-range")
-(autoload 'gnus-remove-from-range "gnus-range")
;; FIXME none of these are used explicitly in this file.
(autoload 'gnus-sorted-intersection "gnus-range")
(autoload 'gnus-intersection "gnus-range")
@@ -1044,10 +1043,9 @@ See `find-file-noselect' for the arguments."
mark
(cond
((eq what 'add)
- (gnus-range-add (cdr (assoc mark backend-marks)) range))
+ (range-concat (cdr (assoc mark backend-marks)) range))
((eq what 'del)
- (gnus-remove-from-range
- (cdr (assoc mark backend-marks)) range))
+ (range-remove (cdr (assoc mark backend-marks)) range))
((eq what 'set)
range))
backend-marks)))))
diff --git a/lisp/gnus/nnimap.el b/lisp/gnus/nnimap.el
index cff628061e9..afd5418912f 100644
--- a/lisp/gnus/nnimap.el
+++ b/lisp/gnus/nnimap.el
@@ -1660,13 +1660,13 @@ If LIMIT, first try to limit the search to the N last articles."
(cdr (assoc '%Seen flags))
(cdr (assoc '%Deleted flags))))
(cdr (assoc '%Flagged flags)))))
- (read (gnus-range-difference
+ (read (range-difference
(cons start-article high) unread)))
(when (> start-article 1)
(setq read
(gnus-range-nconcat
(if (> start-article 1)
- (gnus-sorted-range-intersection
+ (range-intersection
(cons 1 (1- start-article))
(gnus-info-read info))
(gnus-info-read info))
@@ -1691,7 +1691,7 @@ If LIMIT, first try to limit the search to the N last articles."
(pop old-marks)
(when (and old-marks
(> start-article 1))
- (setq old-marks (gnus-range-difference
+ (setq old-marks (range-difference
old-marks
(cons start-article high)))
(setq new-marks (gnus-range-nconcat old-marks new-marks)))
@@ -1702,15 +1702,15 @@ If LIMIT, first try to limit the search to the N last articles."
(active (gnus-active group))
(unexists
(if completep
- (gnus-range-difference
+ (range-difference
active
(gnus-compress-sequence existing))
- (gnus-add-to-range
+ (range-add-list
(cdr old-unexists)
- (gnus-list-range-difference
+ (range-list-difference
existing (gnus-active group))))))
(when (> (car active) 1)
- (setq unexists (gnus-range-add
+ (setq unexists (range-concat
(cons 1 (1- (car active)))
unexists)))
(if old-unexists
@@ -1733,10 +1733,9 @@ If LIMIT, first try to limit the search to the N last articles."
(defun nnimap-update-qresync-info (info existing vanished flags)
;; Add all the vanished articles to the list of read articles.
(setf (gnus-info-read info)
- (gnus-add-to-range
- (gnus-add-to-range
- (gnus-range-add (gnus-info-read info)
- vanished)
+ (range-add-list
+ (range-add-list
+ (range-concat (gnus-info-read info) vanished)
(cdr (assq '%Flagged flags)))
(cdr (assq '%Seen flags))))
(let ((marks (gnus-info-marks info)))
@@ -1750,9 +1749,9 @@ If LIMIT, first try to limit the search to the N last articles."
(setq marks (delq ticks marks))
(pop ticks)
;; Add the new marks we got.
- (setq ticks (gnus-add-to-range ticks new-marks))
+ (setq ticks (range-add-list ticks new-marks))
;; Remove the marks from messages that don't have them.
- (setq ticks (gnus-remove-from-range
+ (setq ticks (range-remove
ticks
(gnus-compress-sequence
(gnus-sorted-complement existing new-marks))))
@@ -1762,7 +1761,7 @@ If LIMIT, first try to limit the search to the N last articles."
;; Add vanished to the list of unexisting articles.
(when vanished
(let* ((old-unexists (assq 'unexist marks))
- (unexists (gnus-range-add (cdr old-unexists) vanished)))
+ (unexists (range-concat (cdr old-unexists) vanished)))
(if old-unexists
(setcdr old-unexists unexists)
(push (cons 'unexist unexists) marks)))
@@ -2242,7 +2241,7 @@ Return the server's response to the SELECT or EXAMINE command."
(while (re-search-forward "^\\([0-9]+\\) OK\\b" nil t)
(setq sequence (string-to-number (match-string 1)))
(when (setq range (cadr (assq sequence sequences)))
- (push (gnus-uncompress-range range) copied)))
+ (push (range-uncompress range) copied)))
(gnus-compress-sequence (sort (apply #'nconc copied) #'<))))
(defun nnimap-new-articles (flags)
diff --git a/lisp/gnus/nnmaildir.el b/lisp/gnus/nnmaildir.el
index 690761a2d6c..30f473b1291 100644
--- a/lisp/gnus/nnmaildir.el
+++ b/lisp/gnus/nnmaildir.el
@@ -1006,10 +1006,10 @@ This variable is set by `nnmaildir-request-article'.")
existing (nnmaildir--grp-nlist group)
existing (mapcar #'car existing)
existing (nreverse existing)
- existing (gnus-compress-sequence existing 'always-list)
+ existing (range-compress-list existing)
missing (list (cons 1 (nnmaildir--group-maxnum
nnmaildir--cur-server group)))
- missing (gnus-range-difference missing existing)
+ missing (range-difference missing existing)
dir (nnmaildir--srv-dir nnmaildir--cur-server)
dir (nnmaildir--srvgrp-dir dir gname)
dir (nnmaildir--nndir dir)
@@ -1076,10 +1076,10 @@ This variable is set by `nnmaildir-request-article'.")
(let ((article (nnmaildir--flist-art flist prefix)))
(when article
(push (nnmaildir--art-num article) article-list))))))
- (setq ranges (gnus-add-to-range ranges (sort article-list #'<)))))
+ (setq ranges (range-add-list ranges (sort article-list #'<)))))
(if (eq mark 'read) (setq read ranges)
(if ranges (setq marks (cons (cons mark ranges) marks)))))
- (setf (gnus-info-read info) (gnus-range-add read missing))
+ (setf (gnus-info-read info) (range-concat read missing))
(gnus-info-set-marks info marks 'extend)
(setf (nnmaildir--grp-mmth group) new-mmth)
info)))
@@ -1548,11 +1548,11 @@ This variable is set by `nnmaildir-request-article'.")
(unless group
(setf (nnmaildir--srv-error nnmaildir--cur-server)
(if gname (concat "No such group: " gname) "No current group"))
- (throw 'return (gnus-uncompress-range ranges)))
+ (throw 'return (range-uncompress ranges)))
(setq gname (nnmaildir--grp-name group)
pgname (nnmaildir--pgname nnmaildir--cur-server gname))
(if (nnmaildir--param pgname 'read-only)
- (throw 'return (gnus-uncompress-range ranges)))
+ (throw 'return (range-uncompress ranges)))
(setq time (nnmaildir--param pgname 'expire-age))
(unless time
(setq time (or (and nnmail-expiry-wait-function
@@ -1564,7 +1564,7 @@ This variable is set by `nnmaildir-request-article'.")
(setq time (round (* time 86400))))))
(when no-force
(unless (integerp time) ;; handle 'never
- (throw 'return (gnus-uncompress-range ranges)))
+ (throw 'return (range-uncompress ranges)))
(setq boundary (time-since time)))
(setq dir (nnmaildir--srv-dir nnmaildir--cur-server)
dir (nnmaildir--srvgrp-dir dir gname)
@@ -1686,7 +1686,7 @@ This variable is set by `nnmaildir-request-article'.")
(setf (nnmaildir--srv-error nnmaildir--cur-server)
(concat "No such group: " gname))
(dolist (action actions)
- (setq ranges (gnus-range-add ranges (car action))))
+ (setq ranges (range-concat ranges (car action))))
(throw 'return ranges))
(setq nlist (nnmaildir--grp-nlist group)
marksdir (nnmaildir--srv-dir nnmaildir--cur-server)
diff --git a/lisp/gnus/nnmairix.el b/lisp/gnus/nnmairix.el
index 8ca1cf0fe8b..4e8e329f983 100644
--- a/lisp/gnus/nnmairix.el
+++ b/lisp/gnus/nnmairix.el
@@ -597,7 +597,7 @@ Other back ends might or might not work.")
(dolist (cur actions)
(let ((type (nth 1 cur))
(cmdmarks (nth 2 cur))
- (range (gnus-uncompress-range (nth 0 cur)))
+ (range (range-uncompress (nth 0 cur)))
mid ogroup temp) ;; number method
(when (and corr
(not (zerop (cadr corr))))
diff --git a/lisp/gnus/nnmbox.el b/lisp/gnus/nnmbox.el
index 5a350aac746..96ecc34e156 100644
--- a/lisp/gnus/nnmbox.el
+++ b/lisp/gnus/nnmbox.el
@@ -529,7 +529,7 @@
;; add article to index, either by building complete list
;; in reverse order, or as a list of ranges.
(if (not nnmbox-group-building-active-articles)
- (setcdr entry (gnus-add-to-range (cdr entry) (list article)))
+ (setcdr entry (range-add-list (cdr entry) (list article)))
(when (memq article (cdr entry))
(switch-to-buffer nnmbox-mbox-buffer)
(error "Article %s:%d already exists!" group article))
@@ -548,10 +548,10 @@
nnmbox-group-active-articles)
(car nnmbox-group-active-articles)))))
;; remove article from index
- (setcdr entry (gnus-remove-from-range (cdr entry) (list article)))))
+ (setcdr entry (range-remove (cdr entry) (list article)))))
(defun nnmbox-is-article-active-p (article)
- (gnus-member-of-range
+ (range-member-p
article
(cdr (assoc nnmbox-current-group
nnmbox-group-active-articles))))
diff --git a/lisp/gnus/nnml.el b/lisp/gnus/nnml.el
index afdb0c780a5..7fe2b516cce 100644
--- a/lisp/gnus/nnml.el
+++ b/lisp/gnus/nnml.el
@@ -1078,21 +1078,20 @@ Use the nov database for the current group if available."
;; #### doing anything on them.
;; 2 a/ read articles:
(let ((read (gnus-info-read info)))
- (setq read (gnus-remove-from-range read (list new-number)))
- (when (gnus-member-of-range old-number read)
- (setq read (gnus-remove-from-range read (list old-number)))
- (setq read (gnus-add-to-range read (list new-number))))
+ (setq read (range-remove read (list new-number)))
+ (when (range-member-p old-number read)
+ (setq read (range-remove read (list old-number)))
+ (setq read (range-add-list read (list new-number))))
(setf (gnus-info-read info) read))
;; 2 b/ marked articles:
(let ((oldmarks (gnus-info-marks info))
mark newmarks)
(while (setq mark (pop oldmarks))
- (setcdr mark (gnus-remove-from-range (cdr mark)
- (list new-number)))
- (when (gnus-member-of-range old-number (cdr mark))
- (setcdr mark (gnus-remove-from-range (cdr mark)
- (list old-number)))
- (setcdr mark (gnus-add-to-range (cdr mark)
+ (setcdr mark (range-remove (cdr mark) (list new-number)))
+ (when (range-member-p old-number (cdr mark))
+ (setcdr mark (range-remove (cdr mark)
+ (list old-number)))
+ (setcdr mark (range-add-list (cdr mark)
(list new-number))))
(push mark newmarks))
(setf (gnus-info-marks info) newmarks))
diff --git a/lisp/gnus/nnselect.el b/lisp/gnus/nnselect.el
index 9d744ea411e..205456a57df 100644
--- a/lisp/gnus/nnselect.el
+++ b/lisp/gnus/nnselect.el
@@ -207,7 +207,7 @@ as `(keyfunc member)' and the corresponding element is just
(inline-quote
(cond
((eq ,type 'range)
- (nnselect-categorize (gnus-uncompress-range ,articles)
+ (nnselect-categorize (range-uncompress ,articles)
#'nnselect-article-group #'nnselect-article-number))
((eq ,type 'tuple)
(nnselect-categorize ,articles
@@ -542,10 +542,10 @@ If this variable is nil, or if the provided function returns nil,
(group-info (gnus-get-info artgroup))
(marks (gnus-info-marks group-info))
(unread (gnus-uncompress-sequence
- (gnus-range-difference (gnus-active artgroup)
- (gnus-info-read group-info)))))
+ (range-difference (gnus-active artgroup)
+ (gnus-info-read group-info)))))
(setf (gnus-info-read info)
- (gnus-add-to-range
+ (range-add-list
(gnus-info-read info)
(delq nil (mapcar
(lambda (art)
@@ -567,7 +567,7 @@ If this variable is nil, or if the provided function returns nil,
artids))
(t
(setq mark-list
- (gnus-uncompress-range mark-list))
+ (range-uncompress mark-list))
(mapcar
(lambda (id)
(when (memq (cdr id) mark-list)
@@ -866,16 +866,16 @@ article came from is also searched."
(when (and (gnus-check-backend-function
'request-set-mark artgroup)
(not (gnus-article-unpropagatable-p type)))
- (let* ((old (gnus-list-range-intersection
+ (let* ((old (range-list-intersection
artlist
(alist-get type (gnus-info-marks group-info))))
- (del (gnus-remove-from-range (copy-tree old) list))
- (add (gnus-remove-from-range (copy-tree list) old)))
+ (del (range-remove (copy-tree old) list))
+ (add (range-remove (copy-tree list) old)))
(when add (push (list add 'add (list type)) delta-marks))
(when del
;; Don't delete marks from outside the active range.
;; This shouldn't happen, but is a sanity check.
- (setq del (gnus-sorted-range-intersection
+ (setq del (range-intersection
(gnus-active artgroup) del))
(push (list del 'del (list type)) delta-marks))))
@@ -910,18 +910,18 @@ article came from is also searched."
(< (car elt1) (car elt2))))))
(t
(setq list
- (gnus-compress-sequence
+ (range-compress-list
(gnus-sorted-union
(gnus-sorted-difference
(gnus-uncompress-sequence
(alist-get type (gnus-info-marks group-info)))
artlist)
- (sort list #'<)) t)))
+ (sort list #'<)))))
;; When exiting the group, everything that's previously been
;; unseen is now seen.
(when (eq type 'seen)
- (setq list (gnus-range-add
+ (setq list (range-concat
list (cdr (assoc artgroup select-unseen))))))
(when (or list (eq type 'unexist))
@@ -944,9 +944,9 @@ article came from is also searched."
;; update read and unread
(gnus-update-read-articles
artgroup
- (gnus-uncompress-range
- (gnus-add-to-range
- (gnus-remove-from-range
+ (range-uncompress
+ (range-add-list
+ (range-remove
old-unread
(cdr (assoc artgroup select-reads)))
(sort (cdr (assoc artgroup select-unreads)) #'<))))
diff --git a/lisp/gnus/nnvirtual.el b/lisp/gnus/nnvirtual.el
index 7478a2dd0af..cc87a707ce6 100644
--- a/lisp/gnus/nnvirtual.el
+++ b/lisp/gnus/nnvirtual.el
@@ -365,7 +365,7 @@ It is computed from the marks of individual component groups.")
(lambda (article)
(nnvirtual-reverse-map-article
group article))
- (gnus-uncompress-range
+ (range-uncompress
(gnus-group-expire-articles-1 group))))))
(sort (delq nil unexpired) #'<)))
View Lorry Controller Status