mirrors/emacs
1
Fork 0
mirror of git://git.sv.gnu.org/emacs.git synced 2025-12-06 06:20:55 -08:00
Code Issues Projects Releases Wiki Activity

gnus: replace cl with cl-lib

Browse source 
* lisp/gnus/gnus-agent.el, lisp/gnus/gnus-art.el:
* lisp/gnus/gnus-async.el, lisp/gnus/gnus-cache.el:
* lisp/gnus/gnus-demon.el, lisp/gnus/gnus-group.el:
* lisp/gnus/gnus-icalendar.el, lisp/gnus/gnus-logic.el:
* lisp/gnus/gnus-msg.el, lisp/gnus/gnus-picon.el:
* lisp/gnus/gnus-registry.el, lisp/gnus/gnus-salt.el:
* lisp/gnus/gnus-score.el, lisp/gnus/gnus-spec.el:
* lisp/gnus/gnus-srvr.el, lisp/gnus/gnus-start.el:
* lisp/gnus/gnus-sum.el, lisp/gnus/gnus-topic.el:
* lisp/gnus/gnus-util.el, lisp/gnus/gnus-uu.el, lisp/gnus/gnus-win.el:
* lisp/gnus/mail-source.el, lisp/gnus/mm-decode.el:
* lisp/gnus/mm-encode.el, lisp/gnus/mm-url.el, lisp/gnus/mm-view.el:
* lisp/gnus/mml-smime.el, lisp/gnus/mml.el, lisp/gnus/mml2015.el:
* lisp/gnus/nnbabyl.el, lisp/gnus/nndoc.el, lisp/gnus/nneething.el:
* lisp/gnus/nnheader.el, lisp/gnus/nnimap.el, lisp/gnus/nnmail.el:
* lisp/gnus/nnmaildir.el, lisp/gnus/nnoo.el, lisp/gnus/nnrss.el:
* lisp/gnus/nnspool.el, lisp/gnus/nntp.el, lisp/gnus/nnvirtual.el:
* lisp/gnus/nnweb.el, lisp/gnus/spam.el: Replace cl with cl-lib.
* lisp/gnus/canlock.el, lisp/gnus/gnus-bcklg.el:
* lisp/gnus/gnus-cite.el, lisp/gnus/gnus-cloud.el:
* lisp/gnus/gnus-draft.el, lisp/gnus/gnus-dup.el:
* lisp/gnus/gnus-fun.el, lisp/gnus/gnus-html.el:
* lisp/gnus/gnus-int.el, lisp/gnus/gnus-kill.el, lisp/gnus/gnus-ml.el:
* lisp/gnus/gnus-mlspl.el, lisp/gnus/gnus-range.el:
* lisp/gnus/gnus-undo.el, lisp/gnus/gnus-vm.el:
* lisp/gnus/mm-partial.el, lisp/gnus/mm-uu.el, lisp/gnus/mml1991.el:
* lisp/gnus/nnagent.el, lisp/gnus/nndiary.el, lisp/gnus/nndir.el:
* lisp/gnus/nndraft.el, lisp/gnus/nnfolder.el, lisp/gnus/nngateway.el:
* lisp/gnus/nnmairix.el, lisp/gnus/nnmbox.el, lisp/gnus/nnmh.el:
* lisp/gnus/nnml.el, lisp/gnus/score-mode.el, lisp/gnus/smiley.el:
No need for cl.
This commit is contained in:
Glenn Morris 2018-03-23 16:13:09 -04:00
parent aa83340fd4
commit 4a05f85f5a
73 changed files with 222 additions and 280 deletions
Download patch file Download diff file Expand all files Collapse all files

3
lisp/gnus/canlock.el
View file

@ -41,9 +41,6 @@
;;; Code: ;;; Code:
(eval-when-compile
(require 'cl))
(require 'sha1) (require 'sha1)
(defvar mail-header-separator) (defvar mail-header-separator)

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

@ -31,8 +31,7 @@
(require 'gnus-srvr) (require 'gnus-srvr)
(require 'gnus-util) (require 'gnus-util)
(require 'timer) (require 'timer)
(eval-when-compile (eval-when-compile (require 'cl-lib))
(require 'cl))
(autoload 'gnus-server-update-server "gnus-srvr") (autoload 'gnus-server-update-server "gnus-srvr")
(autoload 'gnus-agent-customize-category "gnus-cus") (autoload 'gnus-agent-customize-category "gnus-cus")
@ -332,9 +331,9 @@ manipulated as follows:
`(progn (defmacro ,name (category) `(progn (defmacro ,name (category)
(list 'cdr (list 'assq '',prop-name category))) (list 'cdr (list 'assq '',prop-name category)))
(defsetf ,name (category) (value) (gv-define-setter ,name (value category)
(list 'gnus-agent-cat-set-property (list 'gnus-agent-cat-set-property
category '',prop-name value)))) category '',prop-name value))))
) )
(defmacro gnus-agent-cat-name (category) (defmacro gnus-agent-cat-name (category)
@ -361,11 +360,7 @@ manipulated as follows:
(gnus-agent-cat-defaccessor (gnus-agent-cat-defaccessor
gnus-agent-cat-enable-undownloaded-faces agent-enable-undownloaded-faces) gnus-agent-cat-enable-undownloaded-faces agent-enable-undownloaded-faces)
(gv-define-simple-setter gnus-agent-cat-groups gnus-agent-set-cat-groups)
;; This form may expand to code that uses CL functions at run-time,
;; but that's OK since those functions will only ever be called from
;; something like `setf', so only when CL is loaded anyway.
(defsetf gnus-agent-cat-groups gnus-agent-set-cat-groups)
(defun gnus-agent-set-cat-groups (category groups) (defun gnus-agent-set-cat-groups (category groups)
(unless (eq groups 'ignore) (unless (eq groups 'ignore)
@ -2180,7 +2175,7 @@ article counts for each of the method's subscribed groups."
'gnus-agent-file-loading-local 'gnus-agent-file-loading-local
'gnus-agent-read-and-cache-local)) 'gnus-agent-read-and-cache-local))
(when gnus-agent-article-local-times (when gnus-agent-article-local-times
(incf gnus-agent-article-local-times))) (cl-incf gnus-agent-article-local-times)))
gnus-agent-article-local)) gnus-agent-article-local))
(defun gnus-agent-read-and-cache-local (file) (defun gnus-agent-read-and-cache-local (file)
@ -3353,9 +3348,9 @@ missing NOV entry. Run gnus-agent-regenerate-group to restore it.")))
(let* ((file-name (nnheader-concat dir (number-to-string (let* ((file-name (nnheader-concat dir (number-to-string
article-number))) article-number)))
(size (float (nth 7 (file-attributes file-name))))) (size (float (nth 7 (file-attributes file-name)))))
(incf bytes-freed size) (cl-incf bytes-freed size)
(incf size-files-deleted size) (cl-incf size-files-deleted size)
(incf files-deleted) (cl-incf files-deleted)
(delete-file file-name)) (delete-file file-name))
(push "expired cached article" actions)) (push "expired cached article" actions))
(setf (nth 1 entry) nil) (setf (nth 1 entry) nil)
@ -3368,13 +3363,13 @@ missing NOV entry. Run gnus-agent-regenerate-group to restore it.")))
marker marker
(- marker position-offset))) (- marker position-offset)))
(incf nov-entries-deleted) (cl-incf nov-entries-deleted)
(let* ((from (point-at-bol)) (let* ((from (point-at-bol))
(to (progn (forward-line 1) (point))) (to (progn (forward-line 1) (point)))
(freed (- to from))) (freed (- to from)))
(incf bytes-freed freed) (cl-incf bytes-freed freed)
(incf position-offset freed) (cl-incf position-offset freed)
(delete-region from to))) (delete-region from to)))
;; If considering all articles is set, I can only ;; If considering all articles is set, I can only
@ -3431,9 +3426,9 @@ expiration tests failed." decoded article-number)
(when (boundp 'gnus-agent-expire-stats) (when (boundp 'gnus-agent-expire-stats)
(let ((stats gnus-agent-expire-stats)) (let ((stats gnus-agent-expire-stats))
(incf (nth 2 stats) bytes-freed) (cl-incf (nth 2 stats) bytes-freed)
(incf (nth 1 stats) files-deleted) (cl-incf (nth 1 stats) files-deleted)
(incf (nth 0 stats) nov-entries-deleted))) (cl-incf (nth 0 stats) nov-entries-deleted)))
(gnus-agent-update-files-total-fetched-for group (- size-files-deleted))))))) (gnus-agent-update-files-total-fetched-for group (- size-files-deleted)))))))
@ -4110,7 +4105,7 @@ agent has fetched."
(let ((sum 0.0) (let ((sum 0.0)
file) file)
(while (setq file (pop delta)) (while (setq file (pop delta))
(incf sum (float (or (nth 7 (file-attributes (cl-incf sum (float (or (nth 7 (file-attributes
(nnheader-concat (nnheader-concat
path path
(if (numberp file) (if (numberp file)
@ -4122,11 +4117,11 @@ agent has fetched."
path nil "^-?[0-9]+$" t)) path nil "^-?[0-9]+$" t))
file) file)
(while (setq file (pop info)) (while (setq file (pop info))
(incf sum (float (or (nth 8 file) 0)))) (cl-incf sum (float (or (nth 8 file) 0))))
(setq delta sum)))) (setq delta sum))))
(setq gnus-agent-need-update-total-fetched-for t) (setq gnus-agent-need-update-total-fetched-for t)
(incf (nth 2 entry) delta)))))) (cl-incf (nth 2 entry) delta))))))
(defun gnus-agent-update-view-total-fetched-for (defun gnus-agent-update-view-total-fetched-for
(group agent-over &optional method path) (group agent-over &optional method path)

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

@ -24,8 +24,7 @@
;;; Code: ;;; Code:
(eval-when-compile (eval-when-compile (require 'cl-lib))
(require 'cl))
(defvar tool-bar-map) (defvar tool-bar-map)
(defvar w3m-minor-mode-map) (defvar w3m-minor-mode-map)
@ -1798,7 +1797,7 @@ Initialized from `text-mode-syntax-table'.")
(if (looking-at (car list)) (if (looking-at (car list))
(setq list nil) (setq list nil)
(setq list (cdr list)) (setq list (cdr list))
(incf i))) (cl-incf i)))
i)) i))
(defun article-hide-headers (&optional _arg _delete) (defun article-hide-headers (&optional _arg _delete)
@ -2221,7 +2220,7 @@ This only works if the article in question is HTML."
(w3m-toggle-inline-images) (w3m-toggle-inline-images)
(dolist (region (gnus-find-text-property-region (point-min) (point-max) (dolist (region (gnus-find-text-property-region (point-min) (point-max)
'image-displayer)) 'image-displayer))
(destructuring-bind (start end function) region (cl-destructuring-bind (start end function) region
(funcall function (get-text-property start 'image-url) (funcall function (get-text-property start 'image-url)
start end))))))) start end)))))))
@ -8211,7 +8210,7 @@ url is put as the `gnus-button-url' overlay property on the button."
(defun gnus-button-handle-news (url) (defun gnus-button-handle-news (url)
"Fetch a news URL." "Fetch a news URL."
(destructuring-bind (_scheme server port group message-id _articles) (cl-destructuring-bind (_scheme server port group message-id _articles)
(gnus-parse-news-url url) (gnus-parse-news-url url)
(cond (cond
(message-id (message-id

6
lisp/gnus/gnus-async.el
View file

@ -24,7 +24,7 @@
;;; Code: ;;; Code:
(eval-when-compile (require 'cl)) (eval-when-compile (require 'cl-lib))
(require 'gnus) (require 'gnus)
(require 'gnus-sum) (require 'gnus-sum)
@ -183,7 +183,7 @@ that was fetched."
d) d)
(while (and (setq d (pop data)) (while (and (setq d (pop data))
(if (numberp n) (if (numberp n)
(natnump (decf n)) (natnump (cl-decf n))
n)) n))
(unless (or (gnus-async-prefetched-article-entry (unless (or (gnus-async-prefetched-article-entry
group (setq article (gnus-data-number d))) group (setq article (gnus-data-number d)))
@ -290,7 +290,7 @@ that was fetched."
;; should check time-since-last-output, which ;; should check time-since-last-output, which
;; needs to be done in nntp.el. ;; needs to be done in nntp.el.
(while (eq article gnus-async-current-prefetch-article) (while (eq article gnus-async-current-prefetch-article)
(incf tries) (cl-incf tries)
(when (nntp-accept-process-output proc) (when (nntp-accept-process-output proc)
(setq tries 0)) (setq tries 0))
(when (and (not nntp-have-messaged) (when (and (not nntp-have-messaged)

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

@ -24,8 +24,6 @@
;;; Code: ;;; Code:
(eval-when-compile (require 'cl))
(require 'gnus) (require 'gnus)
;;; ;;;

6
lisp/gnus/gnus-cache.el
View file

@ -24,7 +24,7 @@
;;; Code: ;;; Code:
(eval-when-compile (require 'cl)) (eval-when-compile (require 'cl-lib))
(require 'gnus) (require 'gnus)
(require 'gnus-sum) (require 'gnus-sum)
@ -863,11 +863,11 @@ supported."
(while (setq file (pop files)) (while (setq file (pop files))
(setq attrs (file-attributes file)) (setq attrs (file-attributes file))
(unless (nth 0 attrs) (unless (nth 0 attrs)
(incf size (float (nth 7 attrs))))))) (cl-incf size (float (nth 7 attrs)))))))
(setq gnus-cache-need-update-total-fetched-for t) (setq gnus-cache-need-update-total-fetched-for t)
(incf (nth 1 entry) (if subtract (- size) size)))))) (cl-incf (nth 1 entry) (if subtract (- size) size))))))
(defun gnus-cache-update-overview-total-fetched-for (group file) (defun gnus-cache-update-overview-total-fetched-for (group file)
(when gnus-cache-total-fetched-hashtb (when gnus-cache-total-fetched-hashtb

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

@ -23,8 +23,6 @@
;;; Code: ;;; Code:
(eval-when-compile (require 'cl))
(require 'gnus) (require 'gnus)
(require 'gnus-range) (require 'gnus-range)
(require 'gnus-art) (require 'gnus-art)

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

@ -28,7 +28,6 @@
;;; Code: ;;; Code:
(eval-when-compile (require 'cl))
(require 'parse-time) (require 'parse-time)
(require 'nnimap) (require 'nnimap)

6
lisp/gnus/gnus-demon.el
View file

@ -24,7 +24,7 @@
;;; Code: ;;; Code:
(eval-when-compile (require 'cl)) (eval-when-compile (require 'cl-lib))
(require 'gnus) (require 'gnus)
(require 'gnus-int) (require 'gnus-int)
@ -101,7 +101,7 @@ If not, and a TIME is given, restart a new idle timer, so FUNC
can be called at the next opportunity. Such a special idle run is can be called at the next opportunity. Such a special idle run is
marked with SPECIAL." marked with SPECIAL."
(unless gnus-inhibit-demon (unless gnus-inhibit-demon
(block run-callback (cl-block run-callback
(when (eq idle t) (when (eq idle t)
(setq idle 0.001)) (setq idle 0.001))
(cond (special (cond (special
@ -117,7 +117,7 @@ marked with SPECIAL."
(run-with-idle-timer idle nil (run-with-idle-timer idle nil
'gnus-demon-run-callback 'gnus-demon-run-callback
func idle time t)))) func idle time t))))
(return-from run-callback))) (cl-return-from run-callback)))
(with-local-quit (with-local-quit
(ignore-errors (ignore-errors
(funcall func)))))) (funcall func))))))

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

@ -30,7 +30,6 @@
(require 'gnus-msg) (require 'gnus-msg)
(require 'nndraft) (require 'nndraft)
(require 'gnus-agent) (require 'gnus-agent)
(eval-when-compile (require 'cl))
;;; Draft minor mode ;;; Draft minor mode

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

@ -29,8 +29,6 @@
;;; Code: ;;; Code:
(eval-when-compile (require 'cl))
(require 'gnus) (require 'gnus)
(require 'gnus-art) (require 'gnus-art)

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

@ -24,9 +24,6 @@
;;; Code: ;;; Code:
(eval-when-compile
(require 'cl))
(require 'mm-util) (require 'mm-util)
(require 'gnus-util) (require 'gnus-util)
(require 'gnus) (require 'gnus)

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

@ -1901,7 +1901,7 @@ If FIRST-TOO, the current line is also eligible as a target."
(insert-char gnus-process-mark 1 t))) (insert-char gnus-process-mark 1 t)))
(unless no-advance (unless no-advance
(gnus-group-next-group 1)) (gnus-group-next-group 1))
(decf n)) (cl-decf n))
(gnus-group-position-point) (gnus-group-position-point)
n)) n))
@ -3924,7 +3924,7 @@ yanked) a list of yanked groups is returned."
(interactive "p") (interactive "p")
(setq arg (or arg 1)) (setq arg (or arg 1))
(let (info group prev out) (let (info group prev out)
(while (>= (decf arg) 0) (while (>= (cl-decf arg) 0)
(when (not (setq info (pop gnus-list-of-killed-groups))) (when (not (setq info (pop gnus-list-of-killed-groups)))
(error "No more newsgroups to yank")) (error "No more newsgroups to yank"))
(push (setq group (nth 1 info)) out) (push (setq group (nth 1 info)) out)

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

@ -28,8 +28,6 @@
;;; Code: ;;; Code:
(eval-when-compile (require 'cl))
(require 'gnus-art) (require 'gnus-art)
(eval-when-compile (require 'mm-decode)) (eval-when-compile (require 'mm-decode))

6
lisp/gnus/gnus-icalendar.el
View file

@ -40,7 +40,7 @@
(require 'gnus-sum) (require 'gnus-sum)
(require 'gnus-art) (require 'gnus-art)
(eval-when-compile (require 'cl)) (eval-when-compile (require 'cl-lib))
(defun gnus-icalendar-find-if (pred seq) (defun gnus-icalendar-find-if (pred seq)
(catch 'found (catch 'found
@ -238,7 +238,7 @@
"\\\\n" "\n" (substring-no-properties value)))))) "\\\\n" "\n" (substring-no-properties value))))))
(accumulate-args (accumulate-args
(mapping) (mapping)
(destructuring-bind (slot . ical-property) mapping (cl-destructuring-bind (slot . ical-property) mapping
(setq args (append (list (setq args (append (list
(intern (concat ":" (symbol-name slot))) (intern (concat ":" (symbol-name slot)))
(map-property ical-property)) (map-property ical-property))
@ -443,7 +443,7 @@ Return nil for non-recurring EVENT."
;; A 0:0 - A .:. -> A 0:0-.:. (default 1) ;; A 0:0 - A .:. -> A 0:0-.:. (default 1)
;; A 0:0 - A+n .:. -> A - A+n .:. ;; A 0:0 - A+n .:. -> A - A+n .:.
((and start-at-midnight ((and start-at-midnight
(plusp start-end-date-diff)) (format "<%s>--<%s %s>" start-date end-date end-time)) (cl-plusp start-end-date-diff)) (format "<%s>--<%s %s>" start-date end-date end-time))
;; default ;; default
;; A .:. - A .:. -> A .:.-.:. ;; A .:. - A .:. -> A .:.-.:.
;; A .:. - B .:. ;; A .:. - B .:.

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

@ -24,8 +24,6 @@
;;; Code: ;;; Code:
(eval-when-compile (require 'cl))
(require 'gnus) (require 'gnus)
(require 'message) (require 'message)
(require 'gnus-range) (require 'gnus-range)

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

@ -25,8 +25,6 @@
;;; Code: ;;; Code:
(eval-when-compile (require 'cl))
(require 'gnus) (require 'gnus)
(require 'gnus-art) (require 'gnus-art)
(require 'gnus-range) (require 'gnus-range)

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

@ -24,7 +24,7 @@
;;; Code: ;;; Code:
(eval-when-compile (require 'cl)) (eval-when-compile (require 'cl-lib))
(require 'gnus) (require 'gnus)
(require 'gnus-score) (require 'gnus-score)

1
lisp/gnus/gnus-ml.el
View file

@ -28,7 +28,6 @@
(require 'gnus) (require 'gnus)
(require 'gnus-msg) (require 'gnus-msg)
(eval-when-compile (require 'cl))
;;; Mailing list minor mode ;;; Mailing list minor mode

1
lisp/gnus/gnus-mlspl.el
View file

@ -24,7 +24,6 @@
;;; Code: ;;; Code:
(eval-when-compile (require 'cl))
(require 'gnus) (require 'gnus)
(require 'gnus-sum) (require 'gnus-sum)
(require 'gnus-group) (require 'gnus-group)

6
lisp/gnus/gnus-msg.el
View file

@ -25,7 +25,7 @@
;;; Code: ;;; Code:
(eval-when-compile (require 'cl)) (eval-when-compile (require 'cl-lib))
(require 'gnus) (require 'gnus)
(require 'message) (require 'message)
@ -1113,11 +1113,11 @@ If SILENT, don't prompt the user."
((and (eq gnus-post-method 'current) ((and (eq gnus-post-method 'current)
(not (memq (car group-method) gnus-discouraged-post-methods)) (not (memq (car group-method) gnus-discouraged-post-methods))
(gnus-get-function group-method 'request-post t)) (gnus-get-function group-method 'request-post t))
(assert (not arg)) (cl-assert (not arg))
group-method) group-method)
;; Use gnus-post-method. ;; Use gnus-post-method.
((listp gnus-post-method) ;A method... ((listp gnus-post-method) ;A method...
(assert (not (listp (car gnus-post-method)))) ;... not a list of methods. (cl-assert (not (listp (car gnus-post-method)))) ;... not a list of methods.
gnus-post-method) gnus-post-method)
;; Use the normal select method (nil or native). ;; Use the normal select method (nil or native).
(t gnus-select-method)))) (t gnus-select-method))))

4
lisp/gnus/gnus-picon.el
View file

@ -37,7 +37,7 @@
;; ;;
;;; Code: ;;; Code:
(eval-when-compile (require 'cl)) (eval-when-compile (require 'cl-lib))
(require 'gnus) (require 'gnus)
(require 'gnus-art) (require 'gnus-art)
@ -211,7 +211,7 @@ replacement is added."
(gnus-article-goto-header header) (gnus-article-goto-header header)
(mail-header-narrow-to-field) (mail-header-narrow-to-field)
(case gnus-picon-style (cl-case gnus-picon-style
(right (right
(when (= (length addresses) 1) (when (= (length addresses) 1)
(setq len (apply '+ (mapcar (lambda (x) (setq len (apply '+ (mapcar (lambda (x)

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

@ -24,8 +24,6 @@
;;; Code: ;;; Code:
(eval-when-compile (require 'cl))
;;; List and range functions ;;; List and range functions
(defsubst gnus-range-normalize (range) (defsubst gnus-range-normalize (range)

32
lisp/gnus/gnus-registry.el
View file

@ -76,7 +76,7 @@
;;; Code: ;;; Code:
(eval-when-compile (require 'cl)) (eval-when-compile (require 'cl-lib))
(eval-when-compile (require 'subr-x)) (eval-when-compile (require 'subr-x))
(require 'gnus) (require 'gnus)
@ -373,7 +373,7 @@ This is not required after changing `gnus-registry-cache-file'."
(grouphashtb (registry-lookup-secondary db 'group)) (grouphashtb (registry-lookup-secondary db 'group))
(old-size (registry-size db))) (old-size (registry-size db)))
(registry-reindex db) (registry-reindex db)
(loop for k being the hash-keys of grouphashtb (cl-loop for k being the hash-keys of grouphashtb
using (hash-values v) using (hash-values v)
when (gnus-registry-ignore-group-p k) when (gnus-registry-ignore-group-p k)
do (registry-delete db v nil)) do (registry-delete db v nil))
@ -444,14 +444,14 @@ This is not required after changing `gnus-registry-cache-file'."
(sender ,sender) (sender ,sender)
(recipient ,@recipients) (recipient ,@recipients)
(subject ,subject))) (subject ,subject)))
(when (second kv) (when (cadr kv)
(let ((new (or (assq (first kv) entry) (let ((new (or (assq (car kv) entry)
(list (first kv))))) (list (car kv)))))
(dolist (toadd (cdr kv)) (dolist (toadd (cdr kv))
(unless (member toadd new) (unless (member toadd new)
(setq new (append new (list toadd))))) (setq new (append new (list toadd)))))
(setq entry (cons new (setq entry (cons new
(assq-delete-all (first kv) entry)))))) (assq-delete-all (car kv) entry))))))
(gnus-message 10 "Gnus registry: new entry for %s is %S" (gnus-message 10 "Gnus registry: new entry for %s is %S"
id id
entry) entry)
@ -505,7 +505,7 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details."
:subject subject :subject subject
:log-agent "Gnus registry fancy splitting with parent"))) :log-agent "Gnus registry fancy splitting with parent")))
(defun* gnus-registry--split-fancy-with-parent-internal (cl-defun gnus-registry--split-fancy-with-parent-internal
(&rest spec (&rest spec
&key references refstr sender subject recipients log-agent &key references refstr sender subject recipients log-agent
&allow-other-keys) &allow-other-keys)
@ -525,7 +525,7 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details."
log-agent refstr) log-agent refstr)
(dolist (reference (nreverse references)) (dolist (reference (nreverse references))
(gnus-message 9 "%s is looking up %s" log-agent reference) (gnus-message 9 "%s is looking up %s" log-agent reference)
(loop for group in (gnus-registry-get-id-key reference 'group) (cl-loop for group in (gnus-registry-get-id-key reference 'group)
when (gnus-registry-follow-group-p group) when (gnus-registry-follow-group-p group)
do do
(progn (progn
@ -548,7 +548,7 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details."
(gnus-registry-get-id-key reference 'group)) (gnus-registry-get-id-key reference 'group))
(registry-lookup-secondary-value db 'subject subject))))) (registry-lookup-secondary-value db 'subject subject)))))
(setq found (setq found
(loop for group in groups (cl-loop for group in groups
when (gnus-registry-follow-group-p group) when (gnus-registry-follow-group-p group)
do (gnus-message do (gnus-message
;; warn more if gnus-registry-track-extra ;; warn more if gnus-registry-track-extra
@ -575,7 +575,7 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details."
(gnus-registry-get-id-key reference 'group)) (gnus-registry-get-id-key reference 'group))
(registry-lookup-secondary-value db 'sender sender))))) (registry-lookup-secondary-value db 'sender sender)))))
(setq found (setq found
(loop for group in groups (cl-loop for group in groups
when (gnus-registry-follow-group-p group) when (gnus-registry-follow-group-p group)
do (gnus-message do (gnus-message
;; warn more if gnus-registry-track-extra ;; warn more if gnus-registry-track-extra
@ -605,7 +605,7 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details."
(registry-lookup-secondary-value (registry-lookup-secondary-value
db 'recipient recp))))) db 'recipient recp)))))
(setq found (setq found
(loop for group in groups (cl-loop for group in groups
when (gnus-registry-follow-group-p group) when (gnus-registry-follow-group-p group)
do (gnus-message do (gnus-message
;; warn more if gnus-registry-track-extra ;; warn more if gnus-registry-track-extra
@ -641,7 +641,7 @@ possible. Uses `gnus-registry-split-strategy'."
out chosen) out chosen)
;; the strategy can be nil, in which case chosen is nil ;; the strategy can be nil, in which case chosen is nil
(setq chosen (setq chosen
(case gnus-registry-split-strategy (cl-case gnus-registry-split-strategy
;; default, take only one-element lists into chosen ;; default, take only one-element lists into chosen
((nil) ((nil)
(and (= (length groups) 1) (and (= (length groups) 1)
@ -693,7 +693,7 @@ possible. Uses `gnus-registry-split-strategy'."
10 10
"%s: stripped group %s to %s" "%s: stripped group %s to %s"
log-agent group short-name)) log-agent group short-name))
(pushnew short-name out :test #'equal)) (cl-pushnew short-name out :test #'equal))
;; else... ;; else...
(gnus-message (gnus-message
7 7
@ -1086,7 +1086,7 @@ only the last one's marks are returned."
(expected (length old)) (expected (length old))
entry) entry)
(while (car-safe old) (while (car-safe old)
(incf count) (cl-incf count)
;; don't use progress reporters for backwards compatibility ;; don't use progress reporters for backwards compatibility
(when (and (< 0 expected) (when (and (< 0 expected)
(= 0 (mod count 100))) (= 0 (mod count 100)))
@ -1096,7 +1096,7 @@ only the last one's marks are returned."
old (cdr-safe old)) old (cdr-safe old))
(let* ((id (car-safe entry)) (let* ((id (car-safe entry))
(rest (cdr-safe entry)) (rest (cdr-safe entry))
(groups (loop for p in rest (groups (cl-loop for p in rest
when (stringp p) when (stringp p)
collect p)) collect p))
extra-cell key val) extra-cell key val)
@ -1232,7 +1232,7 @@ from your existing entries."
(when extra (when extra
(let ((db gnus-registry-db)) (let ((db gnus-registry-db))
(registry-reindex db) (registry-reindex db)
(loop for k being the hash-keys of (oref db data) (cl-loop for k being the hash-keys of (oref db data)
using (hash-value v) using (hash-value v)
do (let ((newv (delq nil (mapcar #'(lambda (entry) do (let ((newv (delq nil (mapcar #'(lambda (entry)
(unless (member (car entry) extra) (unless (member (car entry) extra)

10
lisp/gnus/gnus-salt.el
View file

@ -24,7 +24,7 @@
;;; Code: ;;; Code:
(eval-when-compile (require 'cl)) (eval-when-compile (require 'cl-lib))
(require 'gnus) (require 'gnus)
(require 'gnus-sum) (require 'gnus-sum)
@ -131,7 +131,7 @@ It accepts the same format specs that `gnus-summary-line-format' does."
(defvar gnus-pick-line-number 1) (defvar gnus-pick-line-number 1)
(defun gnus-pick-line-number () (defun gnus-pick-line-number ()
"Return the current line number." "Return the current line number."
(incf gnus-pick-line-number)) (cl-incf gnus-pick-line-number))
(defun gnus-pick-start-reading (&optional catch-up) (defun gnus-pick-start-reading (&optional catch-up)
"Start reading the picked articles. "Start reading the picked articles.
@ -552,7 +552,7 @@ Two predefined functions are available:
(not (one-window-p))) (not (one-window-p)))
(let ((windows 0) (let ((windows 0)
tot-win-height) tot-win-height)
(walk-windows (lambda (_window) (incf windows))) (walk-windows (lambda (_window) (cl-incf windows)))
(setq tot-win-height (setq tot-win-height
(- (frame-height) (- (frame-height)
(* window-min-height (1- windows)) (* window-min-height (1- windows))
@ -734,7 +734,7 @@ it in the environment specified by BINDINGS."
(insert (make-string len ? ))))) (insert (make-string len ? )))))
(defsubst gnus-tree-forward-line (n) (defsubst gnus-tree-forward-line (n)
(while (>= (decf n) 0) (while (>= (cl-decf n) 0)
(unless (zerop (forward-line 1)) (unless (zerop (forward-line 1))
(end-of-line) (end-of-line)
(insert "\n"))) (insert "\n")))
@ -784,7 +784,7 @@ it in the environment specified by BINDINGS."
(progn (progn
(goto-char (point-min)) (goto-char (point-min))
(end-of-line) (end-of-line)
(incf gnus-tmp-indent)) (cl-incf gnus-tmp-indent))
;; Recurse downwards in all children of this article. ;; Recurse downwards in all children of this article.
(while thread (while thread
(gnus-generate-vertical-tree (gnus-generate-vertical-tree

4
lisp/gnus/gnus-score.el
View file

@ -25,7 +25,7 @@
;;; Code: ;;; Code:
(eval-when-compile (require 'cl)) (eval-when-compile (require 'cl-lib))
(require 'gnus) (require 'gnus)
(require 'gnus-sum) (require 'gnus-sum)
@ -3077,7 +3077,7 @@ If ADAPT, return the home adaptive file instead."
(setq score (or (nth 1 kill) (setq score (or (nth 1 kill)
gnus-score-interactive-default-score) gnus-score-interactive-default-score)
n times) n times)
(while (natnump (decf n)) (while (natnump (cl-decf n))
(setq score (funcall gnus-decay-score-function score))) (setq score (funcall gnus-decay-score-function score)))
(setcdr kill (cons score (setcdr kill (cons score
(cdr (cdr kill))))))))) (cdr (cdr kill)))))))))

10
lisp/gnus/gnus-spec.el
View file

@ -24,7 +24,7 @@
;;; Code: ;;; Code:
(eval-when-compile (require 'cl)) (eval-when-compile (require 'cl-lib))
(defvar gnus-newsrc-file-version) (defvar gnus-newsrc-file-version)
(require 'gnus) (require 'gnus)
@ -285,15 +285,15 @@ Return a list of updated types."
;; Find the start position. ;; Find the start position.
(while (and (< seek length) (while (and (< seek length)
(< wseek start)) (< wseek start))
(incf wseek (char-width (aref string seek))) (cl-incf wseek (char-width (aref string seek)))
(incf seek)) (cl-incf seek))
(setq wstart seek) (setq wstart seek)
;; Find the end position. ;; Find the end position.
(while (and (<= seek length) (while (and (<= seek length)
(or (not end) (or (not end)
(<= wseek end))) (<= wseek end)))
(incf wseek (char-width (aref string seek))) (cl-incf wseek (char-width (aref string seek)))
(incf seek)) (cl-incf seek))
(setq wend seek) (setq wend seek)
(substring string wstart (1- wend)))) (substring string wstart (1- wend))))

4
lisp/gnus/gnus-srvr.el
View file

@ -24,7 +24,7 @@
;;; Code: ;;; Code:
(eval-when-compile (require 'cl)) (eval-when-compile (require 'cl-lib))
(require 'gnus) (require 'gnus)
(require 'gnus-start) (require 'gnus-start)
@ -969,7 +969,7 @@ how new groups will be entered into the group buffer."
(not (eobp)) (not (eobp))
(gnus-browse-unsubscribe-group) (gnus-browse-unsubscribe-group)
(zerop (gnus-browse-next-group ward))) (zerop (gnus-browse-next-group ward)))
(decf arg)) (cl-decf arg))
(gnus-group-position-point) (gnus-group-position-point)
(when (/= 0 arg) (when (/= 0 arg)
(gnus-message 7 "No more newsgroups")) (gnus-message 7 "No more newsgroups"))

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

@ -36,8 +36,7 @@
(autoload 'gnus-agent-save-local "gnus-agent") (autoload 'gnus-agent-save-local "gnus-agent")
(autoload 'gnus-agent-possibly-alter-active "gnus-agent") (autoload 'gnus-agent-possibly-alter-active "gnus-agent")
(eval-when-compile (eval-when-compile (require 'cl-lib))
(require 'cl))
(defvar gnus-agent-covered-methods) (defvar gnus-agent-covered-methods)
(defvar gnus-agent-file-loading-local) (defvar gnus-agent-file-loading-local)
@ -1231,14 +1230,14 @@ for new groups, and subscribe the new groups as zombies."
(let ((do-sub (gnus-matches-options-n group))) (let ((do-sub (gnus-matches-options-n group)))
(cond (cond
((eq do-sub 'subscribe) ((eq do-sub 'subscribe)
(incf groups) (cl-incf groups)
(gnus-sethash group group gnus-killed-hashtb) (gnus-sethash group group gnus-killed-hashtb)
(gnus-call-subscribe-functions (gnus-call-subscribe-functions
gnus-subscribe-options-newsgroup-method group)) gnus-subscribe-options-newsgroup-method group))
((eq do-sub 'ignore) ((eq do-sub 'ignore)
nil) nil)
(t (t
(incf groups) (cl-incf groups)
(gnus-sethash group group gnus-killed-hashtb) (gnus-sethash group group gnus-killed-hashtb)
(if gnus-subscribe-hierarchical-interactive (if gnus-subscribe-hierarchical-interactive
(push group new-newsgroups) (push group new-newsgroups)
@ -1700,7 +1699,7 @@ backend check whether the group actually exists."
;; aren't equal (and that need extension; i.e., they are async). ;; aren't equal (and that need extension; i.e., they are async).
(let ((methods nil)) (let ((methods nil))
(dolist (elem type-cache) (dolist (elem type-cache)
(destructuring-bind (method method-type infos dummy) elem (cl-destructuring-bind (method method-type infos dummy) elem
(let ((gnus-opened-servers methods)) (let ((gnus-opened-servers methods))
(when (and (gnus-similar-server-opened method) (when (and (gnus-similar-server-opened method)
(gnus-check-backend-function (gnus-check-backend-function
@ -1723,7 +1722,7 @@ backend check whether the group actually exists."
;; Clear out all the early methods. ;; Clear out all the early methods.
(dolist (elem type-cache) (dolist (elem type-cache)
(destructuring-bind (method method-type infos dummy) elem (cl-destructuring-bind (method method-type infos dummy) elem
(when (and method (when (and method
infos infos
(gnus-check-backend-function (gnus-check-backend-function
@ -1740,7 +1739,7 @@ backend check whether the group actually exists."
(let ((done-methods nil) (let ((done-methods nil)
sanity-spec) sanity-spec)
(dolist (elem type-cache) (dolist (elem type-cache)
(destructuring-bind (method method-type infos dummy) elem (cl-destructuring-bind (method method-type infos dummy) elem
(setq sanity-spec (list (car method) (cadr method))) (setq sanity-spec (list (car method) (cadr method)))
(when (and method infos (when (and method infos
(not (gnus-method-denied-p method))) (not (gnus-method-denied-p method)))
@ -1771,7 +1770,7 @@ backend check whether the group actually exists."
;; Do the rest of the retrieval. ;; Do the rest of the retrieval.
(dolist (elem type-cache) (dolist (elem type-cache)
(destructuring-bind (method method-type infos early-data) elem (cl-destructuring-bind (method method-type infos early-data) elem
(when (and method infos (when (and method infos
(not (gnus-method-denied-p method))) (not (gnus-method-denied-p method)))
(let ((updatep (gnus-check-backend-function (let ((updatep (gnus-check-backend-function
@ -1795,11 +1794,11 @@ backend check whether the group actually exists."
;; are in the secondary select list. ;; are in the secondary select list.
((eq type 'secondary) ((eq type 'secondary)
(let ((i 2)) (let ((i 2))
(block nil (cl-block nil
(dolist (smethod gnus-secondary-select-methods) (cl-dolist (smethod gnus-secondary-select-methods)
(when (equal method smethod) (when (equal method smethod)
(return i)) (cl-return i))
(incf i)) (cl-incf i))
i))) i)))
;; Just say that all foreign groups have the same rank. ;; Just say that all foreign groups have the same rank.
(t (t

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

@ -3809,7 +3809,7 @@ the thread are to be displayed."
1) 1)
(t 0)))) (t 0))))
(when (and level (zerop level) gnus-tmp-new-adopts) (when (and level (zerop level) gnus-tmp-new-adopts)
(incf number (cl-incf number
(apply '+ (mapcar (apply '+ (mapcar
'gnus-summary-number-of-articles-in-thread 'gnus-summary-number-of-articles-in-thread
gnus-tmp-new-adopts)))) gnus-tmp-new-adopts))))
@ -4411,7 +4411,7 @@ Returns HEADER if it was entered in the DEPENDENCIES. Returns nil otherwise."
(setq end (1+ (point))) (setq end (1+ (point)))
(when (search-backward "<" nil t) (when (search-backward "<" nil t)
(setq new-child (buffer-substring (point) end)) (setq new-child (buffer-substring (point) end))
(push (list (incf generation) (push (list (cl-incf generation)
child (setq child new-child) child (setq child new-child)
subject date) subject date)
relations))) relations)))
@ -4432,7 +4432,7 @@ Returns HEADER if it was entered in the DEPENDENCIES. Returns nil otherwise."
(push gnus-reffed-article-number gnus-newsgroup-sparse) (push gnus-reffed-article-number gnus-newsgroup-sparse)
(push (cons gnus-reffed-article-number gnus-sparse-mark) (push (cons gnus-reffed-article-number gnus-sparse-mark)
gnus-newsgroup-reads) gnus-newsgroup-reads)
(decf gnus-reffed-article-number))) (cl-decf gnus-reffed-article-number)))
(gnus-message 7 "Making sparse threads...done"))) (gnus-message 7 "Making sparse threads...done")))
(defun gnus-build-old-threads () (defun gnus-build-old-threads ()
@ -4725,7 +4725,7 @@ If LINE, insert the rebuilt thread starting on line LINE."
(setq parent (gnus-parent-id references))) (setq parent (gnus-parent-id references)))
(car (gnus-id-to-thread parent)) (car (gnus-id-to-thread parent))
nil)) nil))
(decf generation)) (cl-decf generation))
(and (not (eq headers in-headers)) (and (not (eq headers in-headers))
headers))) headers)))
@ -5469,7 +5469,7 @@ or a straight list of headers."
(nthcdr 1 thread)) (nthcdr 1 thread))
stack)) stack))
(push (if (nth 1 thread) 1 0) tree-stack) (push (if (nth 1 thread) 1 0) tree-stack)
(incf gnus-tmp-level) (cl-incf gnus-tmp-level)
(setq threads (if thread-end nil (cdar thread))) (setq threads (if thread-end nil (cdar thread)))
(if gnus-summary-display-while-building (if gnus-summary-display-while-building
(if building-count (if building-count
@ -6117,7 +6117,7 @@ If SELECT-ARTICLES, only select those articles from GROUP."
(let ((i 5)) (let ((i 5))
(while (and (> i 2) (while (and (> i 2)
(not (nth i info))) (not (nth i info)))
(when (nthcdr (decf i) info) (when (nthcdr (cl-decf i) info)
(setcdr (nthcdr i info) nil))))))) (setcdr (nthcdr i info) nil)))))))
(defun gnus-set-mode-line (where) (defun gnus-set-mode-line (where)
@ -6657,7 +6657,7 @@ current article will be taken into consideration."
(if backward (if backward
(gnus-summary-find-prev nil article) (gnus-summary-find-prev nil article)
(gnus-summary-find-next nil article))) (gnus-summary-find-next nil article)))
(decf n))) (cl-decf n)))
(nreverse articles))) (nreverse articles)))
((and (and transient-mark-mode mark-active) (mark)) ((and (and transient-mark-mode mark-active) (mark))
(message "region active") (message "region active")
@ -8761,7 +8761,7 @@ If ALL, mark even excluded ticked and dormants as read."
(let ((num 0)) (let ((num 0))
(while threads (while threads
(when (memq (mail-header-number (caar threads)) gnus-newsgroup-limit) (when (memq (mail-header-number (caar threads)) gnus-newsgroup-limit)
(incf num)) (cl-incf num))
(pop threads)) (pop threads))
(< num 2))) (< num 2)))
@ -8893,7 +8893,7 @@ fetch-old-headers verbiage, and so on."
gnus-summary-expunge-below)) gnus-summary-expunge-below))
;; We increase the expunge-tally here, but that has ;; We increase the expunge-tally here, but that has
;; nothing to do with the limits, really. ;; nothing to do with the limits, really.
(incf gnus-newsgroup-expunged-tally) (cl-incf gnus-newsgroup-expunged-tally)
;; We also mark as read here, if that's wanted. ;; We also mark as read here, if that's wanted.
(when (and gnus-summary-mark-below (when (and gnus-summary-mark-below
(< score gnus-summary-mark-below)) (< score gnus-summary-mark-below))
@ -8918,7 +8918,7 @@ fetch-old-headers verbiage, and so on."
(defun gnus-expunge-thread (thread) (defun gnus-expunge-thread (thread)
"Mark all articles in THREAD as read." "Mark all articles in THREAD as read."
(let* ((number (mail-header-number (car thread)))) (let* ((number (mail-header-number (car thread))))
(incf gnus-newsgroup-expunged-tally) (cl-incf gnus-newsgroup-expunged-tally)
;; We also mark as read here, if that's wanted. ;; We also mark as read here, if that's wanted.
(setq gnus-newsgroup-unreads (setq gnus-newsgroup-unreads
(delq number gnus-newsgroup-unreads)) (delq number gnus-newsgroup-unreads))
@ -8970,7 +8970,7 @@ The difference between N and the number of articles fetched is returned."
(gnus-message 1 "No references in article %d" (gnus-message 1 "No references in article %d"
(gnus-summary-article-number)) (gnus-summary-article-number))
(setq error t)) (setq error t))
(decf n)) (cl-decf n))
(gnus-summary-position-point) (gnus-summary-position-point)
n)) n))
@ -8986,7 +8986,7 @@ Return the number of articles fetched."
(error "No References in the current article") (error "No References in the current article")
;; For each Message-ID in the References header... ;; For each Message-ID in the References header...
(while (string-match "<[^>]*>" ref) (while (string-match "<[^>]*>" ref)
(incf n) (cl-incf n)
;; ... fetch that article. ;; ... fetch that article.
(gnus-summary-refer-article (gnus-summary-refer-article
(prog1 (match-string 0 ref) (prog1 (match-string 0 ref)
@ -11148,7 +11148,7 @@ If NO-EXPIRE, auto-expiry will be inhibited."
(re-search-backward "[\n\r]" (point-at-bol) 'move-to-limit) (re-search-backward "[\n\r]" (point-at-bol) 'move-to-limit)
(when forward (when forward
(when (looking-at "\r") (when (looking-at "\r")
(incf forward)) (cl-incf forward))
(when (<= (+ forward (point)) (point-max)) (when (<= (+ forward (point)) (point-max))
;; Go to the right position on the line. ;; Go to the right position on the line.
(goto-char (+ forward (point))) (goto-char (+ forward (point)))
@ -11728,7 +11728,7 @@ will not be hidden."
(let ((end nil) (let ((end nil)
(count 0)) (count 0))
(while (not end) (while (not end)
(incf count) (cl-incf count)
(when (zerop (mod count 1000)) (when (zerop (mod count 1000))
(message "Hiding all threads... %d" count)) (message "Hiding all threads... %d" count))
(when (or (not predicate) (when (or (not predicate)
@ -11800,7 +11800,7 @@ If SILENT, don't output messages."
(n (abs n))) (n (abs n)))
(while (and (> n 0) (while (and (> n 0)
(gnus-summary-go-to-next-thread backward)) (gnus-summary-go-to-next-thread backward))
(decf n)) (cl-decf n))
(unless silent (unless silent
(gnus-summary-position-point)) (gnus-summary-position-point))
(when (and (not silent) (/= 0 n)) (when (and (not silent) (/= 0 n))
@ -12371,7 +12371,7 @@ If REVERSE, save parts that do not match TYPE."
(cdr gnus-article-current) (cdr gnus-article-current)
gnus-summary-save-parts-counter)))) gnus-summary-save-parts-counter))))
dir))) dir)))
(incf gnus-summary-save-parts-counter) (cl-incf gnus-summary-save-parts-counter)
(unless (file-exists-p file) (unless (file-exists-p file)
(mm-save-part-to-file handle file)))))) (mm-save-part-to-file handle file))))))
@ -12544,7 +12544,7 @@ If REVERSE, save parts that do not match TYPE."
;; article numbers for this article. ;; article numbers for this article.
(mail-header-set-number header gnus-reffed-article-number)) (mail-header-set-number header gnus-reffed-article-number))
(with-current-buffer gnus-summary-buffer (with-current-buffer gnus-summary-buffer
(decf gnus-reffed-article-number) (cl-decf gnus-reffed-article-number)
(gnus-remove-header (mail-header-number header)) (gnus-remove-header (mail-header-number header))
(push header gnus-newsgroup-headers) (push header gnus-newsgroup-headers)
(setq gnus-current-headers header) (setq gnus-current-headers header)
@ -13019,7 +13019,7 @@ If ALL is a number, fetch this number of articles."
gnus-newsgroup-highest i) gnus-newsgroup-highest i)
(while (> i old-high) (while (> i old-high)
(push i new) (push i new)
(decf i)) (cl-decf i))
(if (not new) (if (not new)
(message "No gnus is bad news") (message "No gnus is bad news")
(gnus-summary-insert-articles new) (gnus-summary-insert-articles new)

18
lisp/gnus/gnus-topic.el
View file

@ -25,7 +25,7 @@
;;; Code: ;;; Code:
(eval-when-compile (require 'cl)) (eval-when-compile (require 'cl-lib))
(require 'gnus) (require 'gnus)
(require 'gnus-group) (require 'gnus-group)
@ -128,7 +128,7 @@ See Info node `(gnus)Formatting Variables'."
number) number)
(while entries (while entries
(when (numberp (setq number (car (pop entries)))) (when (numberp (setq number (car (pop entries))))
(incf total number))) (cl-incf total number)))
total)) total))
(defun gnus-group-topic (group) (defun gnus-group-topic (group)
@ -304,7 +304,7 @@ If RECURSIVE is t, return groups in its subtopics too."
(while (and (not (zerop num)) (while (and (not (zerop num))
(setq topic (funcall way topic))) (setq topic (funcall way topic)))
(when (gnus-topic-goto-topic topic) (when (gnus-topic-goto-topic topic)
(decf num))) (cl-decf num)))
(unless (zerop num) (unless (zerop num)
(goto-char (point-max))) (goto-char (point-max)))
num)) num))
@ -510,7 +510,7 @@ articles in the topic and its subtopics."
info entry end active tick) info entry end active tick)
;; Insert any sub-topics. ;; Insert any sub-topics.
(while topicl (while topicl
(incf unread (cl-incf unread
(gnus-topic-prepare-topic (gnus-topic-prepare-topic
(pop topicl) (1+ level) list-level predicate (pop topicl) (1+ level) list-level predicate
(not visiblep) lowest regexp))) (not visiblep) lowest regexp)))
@ -564,7 +564,7 @@ articles in the topic and its subtopics."
(car entry) (gnus-info-method info))))) (car entry) (gnus-info-method info)))))
(when (and (listp entry) (when (and (listp entry)
(numberp (car entry))) (numberp (car entry)))
(incf unread (car entry))) (cl-incf unread (car entry)))
(when (listp entry) (when (listp entry)
(setq tick t)))) (setq tick t))))
(goto-char beg) (goto-char beg)
@ -730,10 +730,10 @@ articles in the topic and its subtopics."
(cdr gnus-group-list-mode))) (cdr gnus-group-list-mode)))
entry) entry)
(while children (while children
(incf unread (gnus-topic-unread (caar (pop children))))) (cl-incf unread (gnus-topic-unread (caar (pop children)))))
(while (setq entry (pop entries)) (while (setq entry (pop entries))
(when (numberp (car entry)) (when (numberp (car entry))
(incf unread (car entry)))) (cl-incf unread (car entry))))
(gnus-topic-insert-topic-line (gnus-topic-insert-topic-line
topic t t (car (gnus-topic-find-topology topic)) nil unread))) topic t t (car (gnus-topic-find-topology topic)) nil unread)))
@ -774,10 +774,10 @@ articles in the topic and its subtopics."
(if reads (if reads
(setq unread (- (gnus-group-topic-unread) reads)) (setq unread (- (gnus-group-topic-unread) reads))
(while children (while children
(incf unread (gnus-topic-unread (caar (pop children))))) (cl-incf unread (gnus-topic-unread (caar (pop children)))))
(while (setq entry (pop entries)) (while (setq entry (pop entries))
(when (numberp (car entry)) (when (numberp (car entry))
(incf unread (car entry))))) (cl-incf unread (car entry)))))
(setq old-unread (gnus-group-topic-unread)) (setq old-unread (gnus-group-topic-unread))
;; Insert the topic line. ;; Insert the topic line.
(gnus-topic-insert-topic-line (gnus-topic-insert-topic-line

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

@ -43,8 +43,6 @@
;;; Code: ;;; Code:
(eval-when-compile (require 'cl))
(require 'gnus-util) (require 'gnus-util)
(require 'gnus) (require 'gnus)

5
lisp/gnus/gnus-util.el
View file

@ -32,8 +32,7 @@
;;; Code: ;;; Code:
(eval-when-compile (eval-when-compile (require 'cl-lib))
(require 'cl))
(require 'time-date) (require 'time-date)
@ -1408,7 +1407,7 @@ SPEC is a predicate specifier that contains stuff like `or', `and',
(symbol-value history) collection)) (symbol-value history) collection))
filtered-choices) filtered-choices)
(dolist (x choices) (dolist (x choices)
(setq filtered-choices (adjoin x filtered-choices))) (setq filtered-choices (cl-adjoin x filtered-choices)))
(nreverse filtered-choices)))))) (nreverse filtered-choices))))))
(unwind-protect (unwind-protect
(progn (progn

6
lisp/gnus/gnus-uu.el
View file

@ -26,7 +26,7 @@
;;; Code: ;;; Code:
(eval-when-compile (require 'cl)) (eval-when-compile (require 'cl-lib))
(require 'gnus) (require 'gnus)
(require 'gnus-art) (require 'gnus-art)
@ -2047,7 +2047,7 @@ If no file has been included, the user will be asked for a file."
(setq length (count-lines (point-min) (point-max))) (setq length (count-lines (point-min) (point-max)))
(setq parts (/ length gnus-uu-post-length)) (setq parts (/ length gnus-uu-post-length))
(unless (< (% length gnus-uu-post-length) 4) (unless (< (% length gnus-uu-post-length) 4)
(incf parts))) (cl-incf parts)))
(when gnus-uu-post-separate-description (when gnus-uu-post-separate-description
(forward-line -1)) (forward-line -1))
@ -2106,7 +2106,7 @@ If no file has been included, the user will be asked for a file."
(insert-buffer-substring uubuf beg end) (insert-buffer-substring uubuf beg end)
(insert beg-line "\n") (insert beg-line "\n")
(setq beg end) (setq beg end)
(incf i) (cl-incf i)
(goto-char (point-min)) (goto-char (point-min))
(re-search-forward (re-search-forward
(concat "^" (regexp-quote mail-header-separator) "$") nil t) (concat "^" (regexp-quote mail-header-separator) "$") nil t)

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

@ -34,9 +34,6 @@
(require 'gnus) (require 'gnus)
(require 'gnus-msg) (require 'gnus-msg)
(eval-when-compile
(require 'cl))
(defvar gnus-vm-inhibit-window-system nil (defvar gnus-vm-inhibit-window-system nil
"Inhibit loading `win-vm' if using a window-system. "Inhibit loading `win-vm' if using a window-system.
Has to be set before gnus-vm is loaded.") Has to be set before gnus-vm is loaded.")

6
lisp/gnus/gnus-win.el
View file

@ -24,7 +24,7 @@
;;; Code: ;;; Code:
(eval-when-compile (require 'cl)) (eval-when-compile (require 'cl-lib))
(require 'gnus) (require 'gnus)
(require 'gnus-util) (require 'gnus-util)
@ -312,7 +312,7 @@ See the Gnus manual for an explanation of the syntax used.")
;; Select the frame in question and do more splits there. ;; Select the frame in question and do more splits there.
(select-frame frame) (select-frame frame)
(setq fresult (or (gnus-configure-frame (elt subs i)) fresult)) (setq fresult (or (gnus-configure-frame (elt subs i)) fresult))
(incf i)) (cl-incf i))
;; Select the frame that has the selected buffer. ;; Select the frame that has the selected buffer.
(when fresult (when fresult
(select-frame (window-frame fresult))))) (select-frame (window-frame fresult)))))
@ -344,7 +344,7 @@ See the Gnus manual for an explanation of the syntax used.")
((eq type 'vertical) ((eq type 'vertical)
(setq s (max s window-min-height)))) (setq s (max s window-min-height))))
(setcar (cdar comp-subs) s) (setcar (cdar comp-subs) s)
(incf total s))) (cl-incf total s)))
;; Take care of the "1.0" spec. ;; Take care of the "1.0" spec.
(if rest (if rest
(setcar (cdr rest) (- len total)) (setcar (cdr rest) (- len total))

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

@ -26,7 +26,7 @@
(require 'format-spec) (require 'format-spec)
(eval-when-compile (eval-when-compile
(require 'cl) (require 'cl-lib)
(require 'imap)) (require 'imap))
(autoload 'auth-source-search "auth-source") (autoload 'auth-source-search "auth-source")
(autoload 'pop3-movemail "pop3") (autoload 'pop3-movemail "pop3")
@ -439,7 +439,7 @@ the `mail-source-keyword-map' variable."
;; the msname is the mail-source parameter ;; the msname is the mail-source parameter
(dolist (msname '(:server :user :port)) (dolist (msname '(:server :user :port))
;; the asname is the auth-source parameter ;; the asname is the auth-source parameter
(let* ((asname (case msname (let* ((asname (cl-case msname
(:server :host) ; auth-source uses :host (:server :host) ; auth-source uses :host
(t msname))) (t msname)))
;; this is the mail-source default ;; this is the mail-source default
@ -786,7 +786,7 @@ Deleting old (> %s day(s)) incoming mail file `%s'." diff bfile)
(when (and (file-regular-p file) (when (and (file-regular-p file)
(funcall predicate file) (funcall predicate file)
(mail-source-movemail file mail-source-crash-box)) (mail-source-movemail file mail-source-crash-box))
(incf found (mail-source-callback callback file)) (cl-incf found (mail-source-callback callback file))
(mail-source-run-script postscript (format-spec-make ?t path)) (mail-source-run-script postscript (format-spec-make ?t path))
(mail-source-delete-crash-box))) (mail-source-delete-crash-box)))
found))) found)))
@ -1041,7 +1041,7 @@ This only works when `display-time' is enabled."
(insert "\001\001\001\001\n")) (insert "\001\001\001\001\n"))
(delete-file file) (delete-file file)
nil)))) nil))))
(incf found (mail-source-callback callback file)) (cl-incf found (mail-source-callback callback file))
(mail-source-delete-crash-box))))) (mail-source-delete-crash-box)))))
found))) found)))
@ -1116,7 +1116,7 @@ This only works when `display-time' is enabled."
(replace-match ">From ")) (replace-match ">From "))
(goto-char (point-max)))) (goto-char (point-max))))
(nnheader-ms-strip-cr)) (nnheader-ms-strip-cr))
(incf found (mail-source-callback callback server)) (cl-incf found (mail-source-callback callback server))
(mail-source-delete-crash-box) (mail-source-delete-crash-box)
(when (and remove fetchflag) (when (and remove fetchflag)
(setq remove (nreverse remove)) (setq remove (nreverse remove))

2
lisp/gnus/mm-decode.el
View file

@ -25,7 +25,7 @@
(require 'mail-parse) (require 'mail-parse)
(require 'mm-bodies) (require 'mm-bodies)
(eval-when-compile (require 'cl)) (eval-when-compile (require 'cl-lib))
(autoload 'gnus-map-function "gnus-util") (autoload 'gnus-map-function "gnus-util")

4
lisp/gnus/mm-encode.el
View file

@ -23,7 +23,7 @@
;;; Code: ;;; Code:
(eval-when-compile (require 'cl)) (eval-when-compile (require 'cl-lib))
(require 'mail-parse) (require 'mail-parse)
(autoload 'mailcap-extension-to-mime "mailcap") (autoload 'mailcap-extension-to-mime "mailcap")
(autoload 'mm-body-7-or-8 "mm-bodies") (autoload 'mm-body-7-or-8 "mm-bodies")
@ -204,7 +204,7 @@ This is either `base64' or `quoted-printable'."
(goto-char (point-min)) (goto-char (point-min))
(skip-chars-forward "\x20-\x7f\r\n\t" limit) (skip-chars-forward "\x20-\x7f\r\n\t" limit)
(while (< (point) limit) (while (< (point) limit)
(incf n8bit) (cl-incf n8bit)
(forward-char 1) (forward-char 1)
(skip-chars-forward "\x20-\x7f\r\n\t" limit)) (skip-chars-forward "\x20-\x7f\r\n\t" limit))
(if (or (< (* 6 n8bit) (- limit (point-min))) (if (or (< (* 6 n8bit) (- limit (point-min)))

2
lisp/gnus/mm-partial.el
View file

@ -24,8 +24,6 @@
;;; Code: ;;; Code:
(eval-when-compile (require 'cl))
(require 'gnus-sum) (require 'gnus-sum)
(require 'mm-util) (require 'mm-util)
(require 'mm-decode) (require 'mm-decode)

4
lisp/gnus/mm-url.el
View file

@ -28,7 +28,7 @@
;;; Code: ;;; Code:
(eval-when-compile (require 'cl)) (eval-when-compile (require 'cl-lib))
(require 'mm-util) (require 'mm-util)
(require 'gnus) (require 'gnus)
@ -318,7 +318,7 @@ If FOLLOW-REFRESH is non-nil, redirect refresh url in META."
(done nil) (done nil)
(first t) (first t)
result) result)
(while (and (not (zerop (decf times))) (while (and (not (zerop (cl-decf times)))
(not done)) (not done))
(with-timeout (mm-url-timeout) (with-timeout (mm-url-timeout)
(unless first (unless first

1
lisp/gnus/mm-uu.el
View file

@ -24,7 +24,6 @@
;;; Code: ;;; Code:
(eval-when-compile (require 'cl))
(require 'mail-parse) (require 'mail-parse)
(require 'nnheader) (require 'nnheader)
(require 'mm-decode) (require 'mm-decode)

4
lisp/gnus/mm-view.el
View file

@ -22,7 +22,7 @@
;;; Code: ;;; Code:
(eval-when-compile (require 'cl)) (eval-when-compile (require 'cl-lib))
(require 'mail-parse) (require 'mail-parse)
(require 'mailcap) (require 'mailcap)
(require 'mm-bodies) (require 'mm-bodies)
@ -561,7 +561,7 @@ If MODE is not set, try to find mode automatically."
(error "Could not identify PKCS#7 type"))))) (error "Could not identify PKCS#7 type")))))
(defun mm-view-pkcs7 (handle &optional from) (defun mm-view-pkcs7 (handle &optional from)
(case (mm-view-pkcs7-get-type handle) (cl-case (mm-view-pkcs7-get-type handle)
(enveloped (mm-view-pkcs7-decrypt handle from)) (enveloped (mm-view-pkcs7-decrypt handle from))
(signed (mm-view-pkcs7-verify handle)) (signed (mm-view-pkcs7-verify handle))
(otherwise (error "Unknown or unimplemented PKCS#7 type")))) (otherwise (error "Unknown or unimplemented PKCS#7 type"))))

4
lisp/gnus/mml-smime.el
View file

@ -24,7 +24,7 @@
;;; Code: ;;; Code:
(eval-when-compile (require 'cl)) (eval-when-compile (require 'cl-lib))
(require 'smime) (require 'smime)
(require 'mm-decode) (require 'mm-decode)
@ -238,7 +238,7 @@ Whether the passphrase is cached at all is controlled by
;; todo: try dns/ldap automatically first, before prompting user ;; todo: try dns/ldap automatically first, before prompting user
(let (certs done) (let (certs done)
(while (not done) (while (not done)
(ecase (read (gnus-completing-read (cl-ecase (read (gnus-completing-read
"Fetch certificate from" "Fetch certificate from"
'("dns" "ldap" "file") t nil nil '("dns" "ldap" "file") t nil nil
"ldap")) "ldap"))

12
lisp/gnus/mml.el
View file

@ -27,7 +27,7 @@
(require 'mm-encode) (require 'mm-encode)
(require 'mm-decode) (require 'mm-decode)
(require 'mml-sec) (require 'mml-sec)
(eval-when-compile (require 'cl)) (eval-when-compile (require 'cl-lib))
(eval-when-compile (require 'url)) (eval-when-compile (require 'url))
(autoload 'message-make-message-id "message") (autoload 'message-make-message-id "message")
@ -798,12 +798,12 @@ be \"related\" or \"alternate\"."
(if (setq recipients (cdr (assq 'recipients cont))) (if (setq recipients (cdr (assq 'recipients cont)))
(message-options-set 'message-recipients recipients)) (message-options-set 'message-recipients recipients))
(let ((style (mml-signencrypt-style (let ((style (mml-signencrypt-style
(first (or sign-item encrypt-item))))) (car (or sign-item encrypt-item)))))
;; check if: we're both signing & encrypting, both methods ;; check if: we're both signing & encrypting, both methods
;; are the same (why would they be different?!), and that ;; are the same (why would they be different?!), and that
;; the signencrypt style allows for combined operation. ;; the signencrypt style allows for combined operation.
(if (and sign-item encrypt-item (equal (first sign-item) (if (and sign-item encrypt-item (equal (car sign-item)
(first encrypt-item)) (car encrypt-item))
(equal style 'combined)) (equal style 'combined))
(funcall (nth 1 encrypt-item) cont t) (funcall (nth 1 encrypt-item) cont t)
;; otherwise, revert to the old behavior. ;; otherwise, revert to the old behavior.
@ -815,7 +815,7 @@ be \"related\" or \"alternate\"."
(defun mml-compute-boundary (cont) (defun mml-compute-boundary (cont)
"Return a unique boundary that does not exist in CONT." "Return a unique boundary that does not exist in CONT."
(let ((mml-boundary (funcall mml-boundary-function (let ((mml-boundary (funcall mml-boundary-function
(incf mml-multipart-number)))) (cl-incf mml-multipart-number))))
(unless mml-inhibit-compute-boundary (unless mml-inhibit-compute-boundary
;; This function tries again and again until it has found ;; This function tries again and again until it has found
;; a unique boundary. ;; a unique boundary.
@ -835,7 +835,7 @@ be \"related\" or \"alternate\"."
(when (re-search-forward (concat "^--" (regexp-quote mml-boundary)) (when (re-search-forward (concat "^--" (regexp-quote mml-boundary))
nil t) nil t)
(setq mml-boundary (funcall mml-boundary-function (setq mml-boundary (funcall mml-boundary-function
(incf mml-multipart-number))) (cl-incf mml-multipart-number)))
(throw 'not-unique nil)))) (throw 'not-unique nil))))
((eq (car cont) 'multipart) ((eq (car cont) 'multipart)
(mapc 'mml-compute-boundary-1 (cddr cont)))) (mapc 'mml-compute-boundary-1 (cddr cont))))

4
lisp/gnus/mml1991.el
View file

@ -25,9 +25,7 @@
;;; Code: ;;; Code:
(eval-when-compile (eval-when-compile (require 'mm-util))
(require 'cl)
(require 'mm-util))
(require 'mm-encode) (require 'mm-encode)
(require 'mml-sec) (require 'mml-sec)

4
lisp/gnus/mml2015.el
View file

@ -27,7 +27,7 @@
;;; Code: ;;; Code:
(eval-when-compile (require 'cl)) (eval-when-compile (require 'cl-lib))
(require 'mm-decode) (require 'mm-decode)
(require 'mm-util) (require 'mm-util)
(require 'mml) (require 'mml)
@ -237,7 +237,7 @@ If set, it overrides the setting of `mml2015-sign-with-sender'."
(setq result (setq result
(concat (concat
result result
(case n-slice (cl-case n-slice
(1 slice) (1 slice)
(otherwise (concat " " slice)))))) (otherwise (concat " " slice))))))
result)) result))

1
lisp/gnus/nnagent.el
View file

@ -26,7 +26,6 @@
(require 'nnheader) (require 'nnheader)
(require 'nnoo) (require 'nnoo)
(eval-when-compile (require 'cl))
(require 'gnus-agent) (require 'gnus-agent)
(require 'nnml) (require 'nnml)

4
lisp/gnus/nnbabyl.el
View file

@ -35,7 +35,7 @@
5 "Ignore rmail errors from this file, you don't have rmail"))) 5 "Ignore rmail errors from this file, you don't have rmail")))
(require 'nnmail) (require 'nnmail)
(require 'nnoo) (require 'nnoo)
(eval-when-compile (require 'cl)) (eval-when-compile (require 'cl-lib))
(nnoo-declare nnbabyl) (nnoo-declare nnbabyl)
@ -103,7 +103,7 @@
(insert ".\n")) (insert ".\n"))
(and (numberp nnmail-large-newsgroup) (and (numberp nnmail-large-newsgroup)
(> number nnmail-large-newsgroup) (> number nnmail-large-newsgroup)
(zerop (% (incf count) 20)) (zerop (% (cl-incf count) 20))
(nnheader-message 5 "nnbabyl: Receiving headers... %d%%" (nnheader-message 5 "nnbabyl: Receiving headers... %d%%"
(floor (* count 100.0) number)))) (floor (* count 100.0) number))))

1
lisp/gnus/nndiary.el
View file

@ -83,7 +83,6 @@
(require 'nnoo) (require 'nnoo)
(require 'nnheader) (require 'nnheader)
(require 'nnmail) (require 'nnmail)
(eval-when-compile (require 'cl))
(require 'gnus-start) (require 'gnus-start)
(require 'gnus-sum) (require 'gnus-sum)

1
lisp/gnus/nndir.el
View file

@ -28,7 +28,6 @@
(require 'nnmh) (require 'nnmh)
(require 'nnml) (require 'nnml)
(require 'nnoo) (require 'nnoo)
(eval-when-compile (require 'cl))
(nnoo-declare nndir (nnoo-declare nndir
nnml nnmh) nnml nnmh)

10
lisp/gnus/nndoc.el
View file

@ -33,7 +33,7 @@
(require 'nnoo) (require 'nnoo)
(require 'gnus-util) (require 'gnus-util)
(require 'mm-util) (require 'mm-util)
(eval-when-compile (require 'cl)) (eval-when-compile (require 'cl-lib))
(nnoo-declare nndoc) (nnoo-declare nndoc)
@ -788,7 +788,7 @@ from the document.")
(setq blk (nndoc-oe-dbx-decode-block))) (setq blk (nndoc-oe-dbx-decode-block)))
(while (and blk (> (car blk) 0) (or (zerop (nth 3 blk)) (while (and blk (> (car blk) 0) (or (zerop (nth 3 blk))
(> (nth 3 blk) p))) (> (nth 3 blk) p)))
(push (list (incf i) p nil nil nil 0) nndoc-dissection-alist) (push (list (cl-incf i) p nil nil nil 0) nndoc-dissection-alist)
(while (and (> (car blk) 0) (> (nth 3 blk) p)) (while (and (> (car blk) 0) (> (nth 3 blk) p))
(goto-char (1+ (nth 3 blk))) (goto-char (1+ (nth 3 blk)))
(setq blk (nndoc-oe-dbx-decode-block))) (setq blk (nndoc-oe-dbx-decode-block)))
@ -927,7 +927,7 @@ from the document.")
(and (re-search-backward nndoc-file-end nil t) (and (re-search-backward nndoc-file-end nil t)
(beginning-of-line))))) (beginning-of-line)))))
(setq body-end (point)) (setq body-end (point))
(push (list (incf i) head-begin head-end body-begin body-end (push (list (cl-incf i) head-begin head-end body-begin body-end
(count-lines body-begin body-end)) (count-lines body-begin body-end))
nndoc-dissection-alist))))) nndoc-dissection-alist)))))
(setq nndoc-dissection-alist (nreverse nndoc-dissection-alist)))) (setq nndoc-dissection-alist (nreverse nndoc-dissection-alist))))
@ -1040,7 +1040,7 @@ PARENT is the message-ID of the parent summary line, or nil for none."
(replace-match line t t summary-insert) (replace-match line t t summary-insert)
(concat summary-insert line))))) (concat summary-insert line)))))
;; Generate dissection information for this entity. ;; Generate dissection information for this entity.
(push (list (incf nndoc-mime-split-ordinal) (push (list (cl-incf nndoc-mime-split-ordinal)
head-begin head-end body-begin body-end head-begin head-end body-begin body-end
(count-lines body-begin body-end) (count-lines body-begin body-end)
article-insert summary-insert) article-insert summary-insert)
@ -1078,7 +1078,7 @@ PARENT is the message-ID of the parent summary line, or nil for none."
part-begin part-end article-insert part-begin part-end article-insert
(concat position (concat position
(and position ".") (and position ".")
(format "%d" (incf part-counter))) (format "%d" (cl-incf part-counter)))
message-id))))))))) message-id)))))))))
;;;###autoload ;;;###autoload

1
lisp/gnus/nndraft.el
View file

@ -31,7 +31,6 @@
(require 'nnmh) (require 'nnmh)
(require 'nnoo) (require 'nnoo)
(require 'mm-util) (require 'mm-util)
(eval-when-compile (require 'cl))
;; The nnoo-import at the end, I think. ;; The nnoo-import at the end, I think.
(declare-function nndraft-request-list "nndraft" (&rest args) t) (declare-function nndraft-request-list "nndraft" (&rest args) t)

4
lisp/gnus/nneething.el
View file

@ -25,7 +25,7 @@
;;; Code: ;;; Code:
(eval-when-compile (require 'cl)) (eval-when-compile (require 'cl-lib))
(require 'mailcap) (require 'mailcap)
(require 'nnheader) (require 'nnheader)
@ -101,7 +101,7 @@ included.")
(nneething-insert-head file) (nneething-insert-head file)
(insert ".\n")) (insert ".\n"))
(incf count) (cl-incf count)
(and large (and large
(zerop (% count 20)) (zerop (% count 20))

1
lisp/gnus/nnfolder.el
View file

@ -32,7 +32,6 @@
(require 'message) (require 'message)
(require 'nnmail) (require 'nnmail)
(require 'nnoo) (require 'nnoo)
(eval-when-compile (require 'cl))
(require 'gnus) (require 'gnus)
(require 'gnus-util) (require 'gnus-util)
(require 'gnus-range) (require 'gnus-range)

1
lisp/gnus/nngateway.el
View file

@ -24,7 +24,6 @@
;;; Code: ;;; Code:
(eval-when-compile (require 'cl))
(require 'nnoo) (require 'nnoo)
(require 'message) (require 'message)

10
lisp/gnus/nnheader.el
View file

@ -26,7 +26,7 @@
;;; Code: ;;; Code:
(eval-when-compile (require 'cl)) (eval-when-compile (require 'cl-lib))
(defvar nnmail-extra-headers) (defvar nnmail-extra-headers)
(defvar gnus-newsgroup-name) (defvar gnus-newsgroup-name)
@ -237,7 +237,7 @@ on your system, you could say something like:
(format "fake+none+%s+%d" gnus-newsgroup-name number) (format "fake+none+%s+%d" gnus-newsgroup-name number)
(format "fake+none+%s+%s" (format "fake+none+%s+%s"
gnus-newsgroup-name gnus-newsgroup-name
(int-to-string (incf nnheader-fake-message-id))))) (int-to-string (cl-incf nnheader-fake-message-id)))))
(defsubst nnheader-fake-message-id-p (id) (defsubst nnheader-fake-message-id-p (id)
(save-match-data ; regular message-id's are <.*> (save-match-data ; regular message-id's are <.*>
@ -612,7 +612,7 @@ the line could be found."
(while (and (eq nnheader-head-chop-length (while (and (eq nnheader-head-chop-length
(nth 1 (mm-insert-file-contents (nth 1 (mm-insert-file-contents
file nil beg file nil beg
(incf beg nnheader-head-chop-length)))) (cl-incf beg nnheader-head-chop-length))))
;; CRLF or CR might be used for the line-break code. ;; CRLF or CR might be used for the line-break code.
(prog1 (not (re-search-forward "\n\r?\n\\|\r\r" nil t)) (prog1 (not (re-search-forward "\n\r?\n\\|\r\r" nil t))
(goto-char (point-max))) (goto-char (point-max)))
@ -784,7 +784,7 @@ If FULL, translate everything."
(when (setq trans (cdr (assq (aref leaf i) (when (setq trans (cdr (assq (aref leaf i)
nnheader-file-name-translation-alist))) nnheader-file-name-translation-alist)))
(aset leaf i trans)) (aset leaf i trans))
(incf i)) (cl-incf i))
(concat path leaf)))) (concat path leaf))))
(defun nnheader-report (backend &rest args) (defun nnheader-report (backend &rest args)
@ -973,7 +973,7 @@ find-file-hook, etc.
(defun nnheader-find-file-noselect (&rest args) (defun nnheader-find-file-noselect (&rest args)
"Open a file with some variables bound. "Open a file with some variables bound.
See `find-file-noselect' for the arguments." See `find-file-noselect' for the arguments."
(letf* ((format-alist nil) (cl-letf* ((format-alist nil)
(auto-mode-alist (mm-auto-mode-alist)) (auto-mode-alist (mm-auto-mode-alist))
((default-value 'major-mode) 'fundamental-mode) ((default-value 'major-mode) 'fundamental-mode)
(enable-local-variables nil) (enable-local-variables nil)

28
lisp/gnus/nnimap.el
View file

@ -27,7 +27,7 @@
;;; Code: ;;; Code:
(eval-when-compile (eval-when-compile
(require 'cl) (require 'cl-lib)
(require 'subr-x)) (require 'subr-x))
(require 'nnheader) (require 'nnheader)
@ -144,7 +144,7 @@ textual parts.")
(defvar nnimap-keepalive-timer nil) (defvar nnimap-keepalive-timer nil)
(defvar nnimap-process-buffers nil) (defvar nnimap-process-buffers nil)
(defstruct nnimap (cl-defstruct nnimap
group process commands capabilities select-result newlinep server group process commands capabilities select-result newlinep server
last-command-time greeting examined stream-type initial-resync) last-command-time greeting examined stream-type initial-resync)
@ -212,12 +212,12 @@ textual parts.")
(defun nnimap-transform-headers () (defun nnimap-transform-headers ()
(goto-char (point-min)) (goto-char (point-min))
(let (article lines size string labels) (let (article lines size string labels)
(block nil (cl-block nil
(while (not (eobp)) (while (not (eobp))
(while (not (looking-at "\\* [0-9]+ FETCH")) (while (not (looking-at "\\* [0-9]+ FETCH"))
(delete-region (point) (progn (forward-line 1) (point))) (delete-region (point) (progn (forward-line 1) (point)))
(when (eobp) (when (eobp)
(return))) (cl-return)))
(goto-char (match-end 0)) (goto-char (match-end 0))
;; Unfold quoted {number} strings. ;; Unfold quoted {number} strings.
(while (re-search-forward (while (re-search-forward
@ -381,7 +381,7 @@ textual parts.")
(setq nnimap-stream 'ssl)) (setq nnimap-stream 'ssl))
(let ((stream (let ((stream
(if (eq nnimap-stream 'undecided) (if (eq nnimap-stream 'undecided)
(loop for type in '(ssl network) (cl-loop for type in '(ssl network)
for stream = (let ((nnimap-stream type)) for stream = (let ((nnimap-stream type))
(nnimap-open-connection-1 buffer)) (nnimap-open-connection-1 buffer))
while (eq stream 'no-connect) while (eq stream 'no-connect)
@ -794,7 +794,7 @@ textual parts.")
(equal id "1") (equal id "1")
(string-match nnimap-fetch-partial-articles type)) (string-match nnimap-fetch-partial-articles type))
(push id parts)))) (push id parts))))
(incf num))) (cl-incf num)))
(nreverse parts))) (nreverse parts)))
(deffoo nnimap-request-group (group &optional server dont-check info) (deffoo nnimap-request-group (group &optional server dont-check info)
@ -1145,7 +1145,7 @@ If LIMIT, first try to limit the search to the N last articles."
;; Just send all the STORE commands without waiting for ;; Just send all the STORE commands without waiting for
;; response. If they're successful, they're successful. ;; response. If they're successful, they're successful.
(dolist (action actions) (dolist (action actions)
(destructuring-bind (range action marks) action (cl-destructuring-bind (range action marks) action
(let ((flags (nnimap-marks-to-flags marks))) (let ((flags (nnimap-marks-to-flags marks)))
(when flags (when flags
(setq sequence (nnimap-send-command (setq sequence (nnimap-send-command
@ -1408,7 +1408,7 @@ If LIMIT, first try to limit the search to the N last articles."
(if (and active uidvalidity unexist) (if (and active uidvalidity unexist)
;; Fetch the last 100 flags. ;; Fetch the last 100 flags.
(setq start (max 1 (- (cdr active) 100))) (setq start (max 1 (- (cdr active) 100)))
(incf (nnimap-initial-resync nnimap-object)) (cl-incf (nnimap-initial-resync nnimap-object))
(setq start 1)) (setq start 1))
(push (list (nnimap-send-command "%s %S" command (push (list (nnimap-send-command "%s %S" command
(utf7-encode group t)) (utf7-encode group t))
@ -1472,7 +1472,7 @@ If LIMIT, first try to limit the search to the N last articles."
(nnimap-update-info info marks))))) (nnimap-update-info info marks)))))
(defun nnimap-update-info (info marks) (defun nnimap-update-info (info marks)
(destructuring-bind (existing flags high low uidnext start-article (cl-destructuring-bind (existing flags high low uidnext start-article
permanent-flags uidvalidity permanent-flags uidvalidity
vanished highestmodseq) marks vanished highestmodseq) marks
(cond (cond
@ -1725,7 +1725,7 @@ If LIMIT, first try to limit the search to the N last articles."
(let (start end articles groups uidnext elems permanent-flags (let (start end articles groups uidnext elems permanent-flags
uidvalidity vanished highestmodseq) uidvalidity vanished highestmodseq)
(dolist (elem sequences) (dolist (elem sequences)
(destructuring-bind (group-sequence flag-sequence totalp group command) (cl-destructuring-bind (group-sequence flag-sequence totalp group command)
elem elem
(setq start (point)) (setq start (point))
(when (and (when (and
@ -1869,7 +1869,7 @@ Return the server's response to the SELECT or EXAMINE command."
(get-buffer-process (current-buffer)) (get-buffer-process (current-buffer))
(nnimap-log-command (nnimap-log-command
(format "%d %s%s\n" (format "%d %s%s\n"
(incf nnimap-sequence) (cl-incf nnimap-sequence)
(apply #'format args) (apply #'format args)
(if (nnimap-newlinep nnimap-object) (if (nnimap-newlinep nnimap-object)
"" ""
@ -2166,7 +2166,7 @@ Return the server's response to the SELECT or EXAMINE command."
(let ((specs nil) (let ((specs nil)
entry) entry)
(dolist (elem list) (dolist (elem list)
(destructuring-bind (article spec) elem (cl-destructuring-bind (article spec) elem
(dolist (group (delete nil (mapcar #'car spec))) (dolist (group (delete nil (mapcar #'car spec)))
(unless (setq entry (assoc group specs)) (unless (setq entry (assoc group specs))
(push (setq entry (list group)) specs)) (push (setq entry (list group)) specs))
@ -2178,12 +2178,12 @@ Return the server's response to the SELECT or EXAMINE command."
(defun nnimap-transform-split-mail () (defun nnimap-transform-split-mail ()
(goto-char (point-min)) (goto-char (point-min))
(let (article bytes) (let (article bytes)
(block nil (cl-block nil
(while (not (eobp)) (while (not (eobp))
(while (not (looking-at "\\* [0-9]+ FETCH.+UID \\([0-9]+\\)")) (while (not (looking-at "\\* [0-9]+ FETCH.+UID \\([0-9]+\\)"))
(delete-region (point) (progn (forward-line 1) (point))) (delete-region (point) (progn (forward-line 1) (point)))
(when (eobp) (when (eobp)
(return))) (cl-return)))
(setq article (match-string 1) (setq article (match-string 1)
bytes (nnimap-get-length)) bytes (nnimap-get-length))
(delete-region (line-beginning-position) (line-end-position)) (delete-region (line-beginning-position) (line-end-position))

12
lisp/gnus/nnmail.el
View file

@ -24,7 +24,7 @@
;;; Code: ;;; Code:
(eval-when-compile (require 'cl)) (eval-when-compile (require 'cl-lib))
(require 'gnus) ; for macro gnus-kill-buffer, at least (require 'gnus) ; for macro gnus-kill-buffer, at least
(require 'nnheader) (require 'nnheader)
@ -781,7 +781,7 @@ If SOURCE is a directory spec, try to return the group name component."
(narrow-to-region start (point)) (narrow-to-region start (point))
(goto-char (point-min)) (goto-char (point-min))
(nnmail-check-duplication message-id func artnum-func) (nnmail-check-duplication message-id func artnum-func)
(incf count) (cl-incf count)
(setq end (point-max)))) (setq end (point-max))))
(goto-char end)) (goto-char end))
count)) count))
@ -927,7 +927,7 @@ If SOURCE is a directory spec, try to return the group name component."
(save-restriction (save-restriction
(narrow-to-region start (point)) (narrow-to-region start (point))
(goto-char (point-min)) (goto-char (point-min))
(incf count) (cl-incf count)
(nnmail-check-duplication message-id func artnum-func) (nnmail-check-duplication message-id func artnum-func)
(setq end (point-max)))) (setq end (point-max))))
(goto-char end))) (goto-char end)))
@ -980,7 +980,7 @@ If SOURCE is a directory spec, try to return the group name component."
(save-restriction (save-restriction
(narrow-to-region start (point)) (narrow-to-region start (point))
(goto-char (point-min)) (goto-char (point-min))
(incf count) (cl-incf count)
(nnmail-check-duplication message-id func artnum-func junk-func) (nnmail-check-duplication message-id func artnum-func junk-func)
(setq end (point-max)))) (setq end (point-max))))
(goto-char end) (goto-char end)
@ -1836,8 +1836,8 @@ be called once per group or once for all groups."
((error quit) ((error quit)
(message "Mail source %s failed: %s" source cond) (message "Mail source %s failed: %s" source cond)
0))) 0)))
(incf total new) (cl-incf total new)
(incf i))) (cl-incf i)))
;; If we did indeed read any incoming spools, we save all info. ;; If we did indeed read any incoming spools, we save all info.
(if (zerop total) (if (zerop total)
(when mail-source-plugged (when mail-source-plugged

13
lisp/gnus/nnmaildir.el
View file

@ -68,8 +68,7 @@
(require 'message) (require 'message)
(require 'nnmail) (require 'nnmail)
(eval-when-compile (eval-when-compile (require 'cl-lib))
(require 'cl))
(defconst nnmaildir-version "Gnus") (defconst nnmaildir-version "Gnus")
@ -165,14 +164,14 @@ This variable is set by `nnmaildir-request-article'.")
(defmacro nnmaildir--nov-set-mtime (nov value) `(aset ,nov 3 ,value)) (defmacro nnmaildir--nov-set-mtime (nov value) `(aset ,nov 3 ,value))
(defmacro nnmaildir--nov-set-extra (nov value) `(aset ,nov 4 ,value)) (defmacro nnmaildir--nov-set-extra (nov value) `(aset ,nov 4 ,value))
(defstruct nnmaildir--art (cl-defstruct nnmaildir--art
(prefix nil :type string) ;; "time.pid.host" (prefix nil :type string) ;; "time.pid.host"
(suffix nil :type string) ;; ":2,flags" (suffix nil :type string) ;; ":2,flags"
(num nil :type natnum) ;; article number (num nil :type natnum) ;; article number
(msgid nil :type string) ;; "<mess.age@id>" (msgid nil :type string) ;; "<mess.age@id>"
(nov nil :type vector)) ;; cached nov structure, or nil (nov nil :type vector)) ;; cached nov structure, or nil
(defstruct nnmaildir--grp (cl-defstruct nnmaildir--grp
(name nil :type string) ;; "group.name" (name nil :type string) ;; "group.name"
(new nil :type list) ;; new/ modtime (new nil :type list) ;; new/ modtime
(cur nil :type list) ;; cur/ modtime (cur nil :type list) ;; cur/ modtime
@ -186,7 +185,7 @@ This variable is set by `nnmaildir-request-article'.")
(mmth nil :type vector)) ;; obarray mapping mark name->dir modtime (mmth nil :type vector)) ;; obarray mapping mark name->dir modtime
; ("Mark Mod Time Hash") ; ("Mark Mod Time Hash")
(defstruct nnmaildir--srv (cl-defstruct nnmaildir--srv
(address nil :type string) ;; server address string (address nil :type string) ;; server address string
(method nil :type list) ;; (nnmaildir "address" ...) (method nil :type list) ;; (nnmaildir "address" ...)
(prefix nil :type string) ;; "nnmaildir+address:" (prefix nil :type string) ;; "nnmaildir+address:"
@ -856,7 +855,7 @@ This variable is set by `nnmaildir-request-article'.")
;; then look in marks directories ;; then look in marks directories
(not (file-exists-p (concat cdir prefix))) (not (file-exists-p (concat cdir prefix)))
(file-exists-p (concat ndir prefix))) (file-exists-p (concat ndir prefix)))
(incf num))))) (cl-incf num)))))
(setf (nnmaildir--grp-cache group) (make-vector num nil)) (setf (nnmaildir--grp-cache group) (make-vector num nil))
(let ((inhibit-quit t)) (let ((inhibit-quit t))
(set (intern gname groups) group)) (set (intern gname groups) group))
@ -1732,7 +1731,7 @@ This variable is set by `nnmaildir-request-article'.")
(setq ranges (car action) (setq ranges (car action)
todo-marks (caddr action)) todo-marks (caddr action))
(dolist (mark todo-marks) (dolist (mark todo-marks)
(pushnew mark all-marks :test #'equal)) (cl-pushnew mark all-marks :test #'equal))
(if (numberp (cdr ranges)) (setq ranges (list ranges))) (if (numberp (cdr ranges)) (setq ranges (list ranges)))
(nnmaildir--nlist-iterate nlist ranges (nnmaildir--nlist-iterate nlist ranges
(cond ((eq 'del (cadr action)) del-action) (cond ((eq 'del (cadr action)) del-action)

2
lisp/gnus/nnmairix.el
View file

@ -134,8 +134,6 @@
;;; Code: ;;; Code:
(eval-when-compile (require 'cl)) ;For (pop (cdr ogroup)).
(require 'nnoo) (require 'nnoo)
(require 'gnus-group) (require 'gnus-group)
(require 'gnus-sum) (require 'gnus-sum)

1
lisp/gnus/nnmbox.el
View file

@ -33,7 +33,6 @@
(require 'nnmail) (require 'nnmail)
(require 'nnoo) (require 'nnoo)
(require 'gnus-range) (require 'gnus-range)
(eval-when-compile (require 'cl))
(nnoo-declare nnmbox) (nnoo-declare nnmbox)

1
lisp/gnus/nnmh.el
View file

@ -33,7 +33,6 @@
(require 'nnmail) (require 'nnmail)
(require 'gnus-start) (require 'gnus-start)
(require 'nnoo) (require 'nnoo)
(eval-when-compile (require 'cl))
(nnoo-declare nnmh) (nnoo-declare nnmh)

1
lisp/gnus/nnml.el
View file

@ -35,7 +35,6 @@
(require 'nnheader) (require 'nnheader)
(require 'nnmail) (require 'nnmail)
(require 'nnoo) (require 'nnoo)
(eval-when-compile (require 'cl))
;; FIXME first is unused in this file. ;; FIXME first is unused in this file.
(autoload 'gnus-article-unpropagatable-p "gnus-sum") (autoload 'gnus-article-unpropagatable-p "gnus-sum")

4
lisp/gnus/nnoo.el
View file

@ -25,7 +25,7 @@
;;; Code: ;;; Code:
(require 'nnheader) (require 'nnheader)
(eval-when-compile (require 'cl)) (eval-when-compile (require 'cl-lib))
(defvar nnoo-definition-alist nil) (defvar nnoo-definition-alist nil)
(defvar nnoo-state-alist nil) (defvar nnoo-state-alist nil)
@ -142,7 +142,7 @@
(if (numberp (nth i (cdr m))) (if (numberp (nth i (cdr m)))
(push `(nth ,i args) margs) (push `(nth ,i args) margs)
(push (nth i (cdr m)) margs)) (push (nth i (cdr m)) margs))
(incf i)) (cl-incf i))
(eval `(deffoo ,(nnoo-symbol backend (nnoo-rest-symbol (car m))) (eval `(deffoo ,(nnoo-symbol backend (nnoo-rest-symbol (car m)))
(&rest args) (&rest args)
(nnoo-parent-function ',backend ',(car m) (nnoo-parent-function ',backend ',(car m)

14
lisp/gnus/nnrss.el
View file

@ -24,7 +24,7 @@
;;; Code: ;;; Code:
(eval-when-compile (require 'cl)) (eval-when-compile (require 'cl-lib))
(require 'gnus) (require 'gnus)
(require 'nnoo) (require 'nnoo)
@ -355,8 +355,8 @@ for decoding when the cdr that the data specify is not available.")
(with-current-buffer nntp-server-buffer (with-current-buffer nntp-server-buffer
(erase-buffer) (erase-buffer)
(dolist (elem nnrss-group-alist) (dolist (elem nnrss-group-alist)
(if (third elem) (if (nth 2 elem)
(insert (car elem) "\t" (third elem) "\n")))) (insert (car elem) "\t" (nth 2 elem) "\n"))))
t) t)
(deffoo nnrss-retrieve-groups (groups &optional server) (deffoo nnrss-retrieve-groups (groups &optional server)
@ -645,7 +645,7 @@ which RSS 2.0 allows."
nnrss-directory)))) nnrss-directory))))
(setq xml (nnrss-fetch file t)) (setq xml (nnrss-fetch file t))
(setq url (or (nth 2 (assoc group nnrss-server-data)) (setq url (or (nth 2 (assoc group nnrss-server-data))
(second (assoc group nnrss-group-alist)))) (cadr (assoc group nnrss-group-alist))))
(unless url (unless url
(setq url (setq url
(cdr (cdr
@ -691,7 +691,7 @@ which RSS 2.0 allows."
(if (and len (integerp (setq len (string-to-number len)))) (if (and len (integerp (setq len (string-to-number len))))
;; actually already in `ls-lisp-format-file-size' but ;; actually already in `ls-lisp-format-file-size' but
;; probably not worth to require it for one function ;; probably not worth to require it for one function
(do ((size (/ len 1.0) (/ size 1024.0)) (cl-do ((size (/ len 1.0) (/ size 1024.0))
(post-fixes (list "" "k" "M" "G" "T" "P" "E") (post-fixes (list "" "k" "M" "G" "T" "P" "E")
(cdr post-fixes))) (cdr post-fixes)))
((< size 1024) ((< size 1024)
@ -705,7 +705,7 @@ which RSS 2.0 allows."
(setq enclosure (list url name len type)))) (setq enclosure (list url name len type))))
(push (push
(list (list
(incf nnrss-group-max) (cl-incf nnrss-group-max)
(current-time) (current-time)
url url
(and subject (nnrss-mime-encode-string subject)) (and subject (nnrss-mime-encode-string subject))
@ -792,7 +792,7 @@ It is useful when `(setq nnrss-use-local t)'."
(insert "RSSDIR='" (expand-file-name nnrss-directory) "'\n") (insert "RSSDIR='" (expand-file-name nnrss-directory) "'\n")
(dolist (elem nnrss-server-data) (dolist (elem nnrss-server-data)
(let ((url (or (nth 2 elem) (let ((url (or (nth 2 elem)
(second (assoc (car elem) nnrss-group-alist))))) (cadr (assoc (car elem) nnrss-group-alist)))))
(insert "$WGET -q -O \"$RSSDIR\"/'" (insert "$WGET -q -O \"$RSSDIR\"/'"
(nnrss-translate-file-chars (concat (car elem) ".xml")) (nnrss-translate-file-chars (concat (car elem) ".xml"))
"' '" url "'\n")))) "' '" url "'\n"))))

4
lisp/gnus/nnspool.el
View file

@ -29,7 +29,7 @@
(require 'nnheader) (require 'nnheader)
(require 'nntp) (require 'nntp)
(require 'nnoo) (require 'nnoo)
(eval-when-compile (require 'cl)) (eval-when-compile (require 'cl-lib))
;; Probably this entire thing should be obsolete. ;; Probably this entire thing should be obsolete.
;; It's only used to init nnspool-spool-directory, so why not just ;; It's only used to init nnspool-spool-directory, so why not just
@ -172,7 +172,7 @@ there.")
(delete-region (point) (point-max))) (delete-region (point) (point-max)))
(and do-message (and do-message
(zerop (% (incf count) 20)) (zerop (% (cl-incf count) 20))
(nnheader-message 5 "nnspool: Receiving headers... %d%%" (nnheader-message 5 "nnspool: Receiving headers... %d%%"
(floor (* count 100.0) number)))) (floor (* count 100.0) number))))

20
lisp/gnus/nntp.el
View file

@ -33,7 +33,7 @@
(nnoo-declare nntp) (nnoo-declare nntp)
(eval-when-compile (require 'cl)) (eval-when-compile (require 'cl-lib))
(autoload 'auth-source-search "auth-source") (autoload 'auth-source-search "auth-source")
@ -565,7 +565,7 @@ retried once before actually displaying the error report."
(nntp-find-connection-buffer nntp-server-buffer))) (nntp-find-connection-buffer nntp-server-buffer)))
(nntp-encode-text) (nntp-encode-text)
;; Make sure we did not forget to encode some of the content. ;; Make sure we did not forget to encode some of the content.
(assert (save-excursion (goto-char (point-min)) (cl-assert (save-excursion (goto-char (point-min))
(not (re-search-forward "[^\000-\377]" nil t)))) (not (re-search-forward "[^\000-\377]" nil t))))
(mm-disable-multibyte) (mm-disable-multibyte)
(process-send-region (nntp-find-connection nntp-server-buffer) (process-send-region (nntp-find-connection nntp-server-buffer)
@ -701,7 +701,7 @@ command whose response triggered the error."
;; `articles' is either a list of article numbers ;; `articles' is either a list of article numbers
;; or a list of article IDs. ;; or a list of article IDs.
article)) article))
(incf count) (cl-incf count)
;; Every 400 requests we have to read the stream in ;; Every 400 requests we have to read the stream in
;; order to avoid deadlocks. ;; order to avoid deadlocks.
(when (or (null articles) ;All requests have been sent. (when (or (null articles) ;All requests have been sent.
@ -713,7 +713,7 @@ command whose response triggered the error."
;; Count replies. ;; Count replies.
(while (nntp-next-result-arrived-p) (while (nntp-next-result-arrived-p)
(setq last-point (point)) (setq last-point (point))
(incf received)) (cl-incf received))
(< received count)) (< received count))
;; If number of headers is greater than 100, give ;; If number of headers is greater than 100, give
;; informative messages. ;; informative messages.
@ -786,7 +786,7 @@ command whose response triggered the error."
"^[.]" "^[.]"
"^[0-9]") "^[0-9]")
nil t) nil t)
(incf received)) (cl-incf received))
(setq last-point (point)) (setq last-point (point))
(< received count))) (< received count)))
(nntp-accept-response)) (nntp-accept-response))
@ -851,7 +851,7 @@ command whose response triggered the error."
(throw 'done nil)) (throw 'done nil))
;; Send the command to the server. ;; Send the command to the server.
(nntp-send-command nil command (pop groups)) (nntp-send-command nil command (pop groups))
(incf count) (cl-incf count)
;; Every 400 requests we have to read the stream in ;; Every 400 requests we have to read the stream in
;; order to avoid deadlocks. ;; order to avoid deadlocks.
(when (or (null groups) ;All requests have been sent. (when (or (null groups) ;All requests have been sent.
@ -865,7 +865,7 @@ command whose response triggered the error."
(goto-char last-point) (goto-char last-point)
;; Count replies. ;; Count replies.
(while (re-search-forward "^[0-9]" nil t) (while (re-search-forward "^[0-9]" nil t)
(incf received)) (cl-incf received))
(setq last-point (point)) (setq last-point (point))
(< received count))) (< received count)))
(nntp-accept-response)))) (nntp-accept-response))))
@ -937,7 +937,7 @@ command whose response triggered the error."
;; `articles' is either a list of article numbers ;; `articles' is either a list of article numbers
;; or a list of article IDs. ;; or a list of article IDs.
article)) article))
(incf count) (cl-incf count)
;; Every 400 requests we have to read the stream in ;; Every 400 requests we have to read the stream in
;; order to avoid deadlocks. ;; order to avoid deadlocks.
(when (or (null articles) ;All requests have been sent. (when (or (null articles) ;All requests have been sent.
@ -950,7 +950,7 @@ command whose response triggered the error."
(while (nntp-next-result-arrived-p) (while (nntp-next-result-arrived-p)
(aset map received (cons (aref map received) (point))) (aset map received (cons (aref map received) (point)))
(setq last-point (point)) (setq last-point (point))
(incf received)) (cl-incf received))
(< received count)) (< received count))
;; If number of headers is greater than 100, give ;; If number of headers is greater than 100, give
;; informative messages. ;; informative messages.
@ -1572,7 +1572,7 @@ If SEND-IF-FORCE, only send authinfo to the server if the
;; Count replies. ;; Count replies.
(while (re-search-forward "^\\([0-9][0-9][0-9]\\) .*\n" (while (re-search-forward "^\\([0-9][0-9][0-9]\\) .*\n"
nil t) nil t)
(incf received) (cl-incf received)
(setq status (match-string 1)) (setq status (match-string 1))
(if (string-match "^[45]" status) (if (string-match "^[45]" status)
(setq status 'error) (setq status 'error)

6
lisp/gnus/nnvirtual.el
View file

@ -38,7 +38,7 @@
(require 'gnus-start) (require 'gnus-start)
(require 'gnus-sum) (require 'gnus-sum)
(require 'gnus-msg) (require 'gnus-msg)
(eval-when-compile (require 'cl)) (eval-when-compile (require 'cl-lib))
(nnoo-declare nnvirtual) (nnoo-declare nnvirtual)
@ -774,13 +774,13 @@ based on the marks on the component groups."
;; We need to convert the unreads to reads. We compress the ;; We need to convert the unreads to reads. We compress the
;; sequence as we go, otherwise it could be huge. ;; sequence as we go, otherwise it could be huge.
(while (and (<= (incf i) nnvirtual-mapping-len) (while (and (<= (cl-incf i) nnvirtual-mapping-len)
unreads) unreads)
(if (= i (car unreads)) (if (= i (car unreads))
(setq unreads (cdr unreads)) (setq unreads (cdr unreads))
;; try to get a range. ;; try to get a range.
(setq beg i) (setq beg i)
(while (and (<= (incf i) nnvirtual-mapping-len) (while (and (<= (cl-incf i) nnvirtual-mapping-len)
(not (= i (car unreads))))) (not (= i (car unreads)))))
(setq i (- i 1)) (setq i (- i 1))
(if (= i beg) (if (= i beg)

14
lisp/gnus/nnweb.el
View file

@ -24,7 +24,7 @@
;;; Code: ;;; Code:
(eval-when-compile (require 'cl)) (eval-when-compile (require 'cl-lib))
(require 'nnoo) (require 'nnoo)
(require 'message) (require 'message)
@ -33,9 +33,7 @@
(require 'nnmail) (require 'nnmail)
(require 'mm-util) (require 'mm-util)
(require 'mm-url) (require 'mm-url)
(eval-and-compile (require 'url)
(ignore-errors
(require 'url)))
(nnoo-declare nnweb) (nnoo-declare nnweb)
@ -362,11 +360,11 @@ Valid types include `google', `dejanews', and `gmane'.")
(current-time-string))) (current-time-string)))
(setq From (match-string 4))) (setq From (match-string 4)))
(widen) (widen)
(incf i) (cl-incf i)
(unless (nnweb-get-hashtb url) (unless (nnweb-get-hashtb url)
(push (push
(list (list
(incf (cdr active)) (cl-incf (cdr active))
(make-full-mail-header (make-full-mail-header
(cdr active) (if Newsgroups (cdr active) (if Newsgroups
(concat "(" Newsgroups ") " Subject) (concat "(" Newsgroups ") " Subject)
@ -398,7 +396,7 @@ Valid types include `google', `dejanews', and `gmane'.")
(nconc nnweb-articles (nnweb-google-parse-1))) (nconc nnweb-articles (nnweb-google-parse-1)))
;; Check if there are more articles to fetch ;; Check if there are more articles to fetch
(goto-char (point-min)) (goto-char (point-min))
(incf i 100) (cl-incf i 100)
(if (or (not (re-search-forward (if (or (not (re-search-forward
"<a [^>]+href=\"\n?\\([^>\" \n\t]+\\)[^<]*<img[^>]+src=[^>]+next" "<a [^>]+href=\"\n?\\([^>\" \n\t]+\\)[^<]*<img[^>]+src=[^>]+next"
nil t)) nil t))
@ -478,7 +476,7 @@ Valid types include `google', `dejanews', and `gmane'.")
(rfc2047-encode-string subject)) (rfc2047-encode-string subject))
(unless (nnweb-get-hashtb (mail-header-xref header)) (unless (nnweb-get-hashtb (mail-header-xref header))
(mail-header-set-number header (incf (cdr active))) (mail-header-set-number header (cl-incf (cdr active)))
(push (list (mail-header-number header) header) map) (push (list (mail-header-number header) header) map)
(nnweb-set-hashtb (cadar map) (car map)))))) (nnweb-set-hashtb (cadar map) (car map))))))
(forward-line 1))) (forward-line 1)))

1
lisp/gnus/score-mode.el
View file

@ -24,7 +24,6 @@
;;; Code: ;;; Code:
(eval-when-compile (require 'cl))
(require 'mm-util) ; for mm-universal-coding-system (require 'mm-util) ; for mm-universal-coding-system
(require 'gnus-util) ; for gnus-pp, gnus-run-mode-hooks (require 'gnus-util) ; for gnus-pp, gnus-run-mode-hooks

1
lisp/gnus/smiley.el
View file

@ -47,7 +47,6 @@
;;; Code: ;;; Code:
(eval-when-compile (require 'cl))
(require 'nnheader) (require 'nnheader)
(require 'gnus-art) (require 'gnus-art)

22
lisp/gnus/spam.el
View file

@ -38,8 +38,6 @@
;;{{{ compilation directives and autoloads/requires ;;{{{ compilation directives and autoloads/requires
(eval-when-compile (require 'cl))
(require 'message) ;for the message-fetch-field functions (require 'message) ;for the message-fetch-field functions
(require 'gnus-sum) (require 'gnus-sum)
(require 'gnus-uu) ; because of key prefix issues (require 'gnus-uu) ; because of key prefix issues
@ -51,6 +49,8 @@
;; for nnimap-split-download-body-default ;; for nnimap-split-download-body-default
(eval-when-compile (require 'nnimap)) (eval-when-compile (require 'nnimap))
(eval-when-compile (require 'cl-lib))
;; autoload query-dig ;; autoload query-dig
(autoload 'query-dig "dig") (autoload 'query-dig "dig")
@ -1164,12 +1164,12 @@ backends)."
(defun spam-article-sort-by-spam-status (h1 h2) (defun spam-article-sort-by-spam-status (h1 h2)
"Sort articles by score." "Sort articles by score."
(let (result) (let (result)
(dolist (header (spam-necessary-extra-headers)) (cl-dolist (header (spam-necessary-extra-headers))
(let ((s1 (spam-summary-score h1 header)) (let ((s1 (spam-summary-score h1 header))
(s2 (spam-summary-score h2 header))) (s2 (spam-summary-score h2 header)))
(unless (= s1 s2) (unless (= s1 s2)
(setq result (< s1 s2)) (setq result (< s1 s2))
(return)))) (cl-return))))
result)) result))
(defvar spam-spamassassin-score-regexp (defvar spam-spamassassin-score-regexp
@ -1205,14 +1205,14 @@ Note this has to be fast."
With SPECIFIC-HEADER, returns only that header's score. With SPECIFIC-HEADER, returns only that header's score.
Will not return a nil score." Will not return a nil score."
(let (score) (let (score)
(dolist (header (cl-dolist (header
(if specific-header (if specific-header
(list specific-header) (list specific-header)
(spam-necessary-extra-headers))) (spam-necessary-extra-headers)))
(setq score (setq score
(spam-extra-header-to-number header headers)) (spam-extra-header-to-number header headers))
(when score (when score
(return))) (cl-return)))
(or score 0))) (or score 0)))
(defun spam-generic-score (&optional recheck) (defun spam-generic-score (&optional recheck)
@ -1661,10 +1661,10 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details."
article-cannot-be-faked) article-cannot-be-faked)
(dolist (backend methods) (cl-dolist (backend methods)
(when (spam-backend-statistical-p backend) (when (spam-backend-statistical-p backend)
(setq article-cannot-be-faked t) (setq article-cannot-be-faked t)
(return))) (cl-return)))
(when (memq 'default methods) (when (memq 'default methods)
(setq article-cannot-be-faked t)) (setq article-cannot-be-faked t))
@ -1749,7 +1749,7 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details."
;; eliminate duplicates ;; eliminate duplicates
(dolist (article (copy-sequence ulist)) (dolist (article (copy-sequence ulist))
(when (memq article rlist) (when (memq article rlist)
(incf delcount) (cl-incf delcount)
(setq rlist (delq article rlist)) (setq rlist (delq article rlist))
(setq ulist (delq article ulist)))) (setq ulist (delq article ulist))))
@ -2299,10 +2299,10 @@ With a non-nil REMOVE, remove the ADDRESSES."
(when (stringp from) (when (stringp from)
(spam-filelist-build-cache type) (spam-filelist-build-cache type)
(let (found) (let (found)
(dolist (address (gethash type spam-caches)) (cl-dolist (address (gethash type spam-caches))
(when (and address (string-match address from)) (when (and address (string-match address from))
(setq found t) (setq found t)
(return))) (cl-return)))
found))) found)))
;;; returns t if the sender is in the whitelist, nil or ;;; returns t if the sender is in the whitelist, nil or