mirrors/emacs
1
Fork 0
mirror of git://git.sv.gnu.org/emacs.git synced 2025-12-15 18:40:39 -08:00
Code Issues Projects Releases Wiki Activity

* lisp/gnus: Use lexical-binding in all the files

Browse source 
* lisp/gnus/gnus-group.el (features): Use `dlet`.
(gnus-tmp-level, gnus-tmp-marked, gnus-tmp-group): Declare vars.
(gnus-group-insert-group-line): Bind dynbound vars via `let` rather
than as formal args.  Bind `number` as dynbound.
(gnus-visual, gnus-score-find-score-files-function)
(gnus-home-score-file, gnus-apply-kill-hook)
(gnus-summary-expunge-below): Declare vars.
(gnus-group-restart, gnus-group-list-plus): Fix `interactive` spec
since the arg is unused.

* lisp/gnus/mail-source.el (mail-source-bind, mail-source-bind-common):
Use `dlet` and suppress the warnings about the non-prefixed dynbound vars.
(mail-source-set-1): Remove unused var `auth-info`.
(mail-source-call-script): Remove unused var `background`.
(mail-source-fetch-pop, mail-source-check-pop): Bind pop3 vars with `dlet`.

* lisp/gnus/gnus-int.el (mail-source-plugged, gnus-inhibit-demon):
Declare vars.
(gnus-server-opened, gnus-status-message)
(gnus-open-server, gnus-close-server, gnus-request-list)
(gnus-finish-retrieve-group-infos, gnus-retrieve-group-data-early)
(gnus-request-list-newsgroups, gnus-request-newgroups)
(gnus-request-regenerate, gnus-request-compact, gnus-request-group)
(gnus-retrieve-groups, gnus-request-post, gnus-request-expunge-group)
(gnus-request-scan, gnus-request-update-info, gnus-request-marks)
(gnus-request-accept-article, gnus-request-create-group)
(gnus-asynchronous-p, gnus-remove-denial):
Bind `gnus-command-method` via `let` rather than as formal args.

* lisp/gnus/gnus-topic.el (gnus-topic-insert-topic-line):
Pass documented vars to eval for `gnus-topic-line-format-spec`.

* lisp/gnus/message.el (message-yank-original): Use `cl-progv` rather
than `eval` to bind the vars from `message-cite-style`.

* lisp/gnus/mml.el (mml-parse-1): Use `apply` instead of `eval`.
(gnus-newsgroup-name, gnus-displaying-mime, gnus-newsgroup-name)
(gnus-article-prepare-hook, gnus-newsgroup-charset)
(gnus-original-article-buffer, gnus-message-buffer)
(message-this-is-news, message-this-is-mail): Declare vars.

* lisp/gnus/deuglify.el (gnus-outlook-rearrange-article): Remove unused
var `cite-marks`.
* lisp/gnus/gnus-art.el (ansi-color-context-region): Declare var.
(gnus-mime-display-attachment-buttons-in-header): Move declaration
before first use.
(gnus-mime-display-alternative): Remove unused var `from`.
* lisp/gnus/gnus-bookmark.el (gnus-bookmark-bmenu-list): Remove unused
var `start` `end`.
* lisp/gnus/gnus-cache.el (gnus-article-decode-hook)
(nnml-generate-active-function): Declare var.
* lisp/gnus/gnus-cite.el (gnus-message-citation-mode): Remove unused
var `keywords`.
* lisp/gnus/gnus-cloud.el (gnus-cloud-encode-data): Remove unused var
`cipher`.
(gnus-cloud-ensure-cloud-group): Remove unused var `method`.
* lisp/gnus/gnus-delay.el (gnus-delay-article): Remove unused var `days`.
* lisp/gnus/gnus-html.el (gnus-html-wash-images): Remove unused vars
`tag`, `string`, and `images`.
(gnus-html-wash-tags): Remove unused vars `string` and `images`.
* lisp/gnus/gnus-msg.el (gnus-msg-mail): Remove unused var `group-name`.
(gnus-group-mail, gnus-group-news, gnus-summary-mail-other-window)
(gnus-summary-news-other-window):
Remove unused vars `group` and `buffer`.
(gnus-configure-posting-styles): Remove unused vars `style` and `attribute`.
* lisp/gnus/gnus-picon.el (gnus-picon-find-face): Remove unused vars
`database`, `directory`, and `instance`.
(gnus-picon-transform-newsgroups): Remove unused var `point`.
* lisp/gnus/gnus-range.el (gnus-range-difference): Remove unused var `safe`.
* lisp/gnus/gnus-score.el (gnus-score-load-file): Remove unused var
`score-fn`.
* lisp/gnus/gnus-sum.el (message-options-set-recipient): Declare var.
* lisp/gnus/gnus-undo.el (gnus-undo): Fix docstring lie.
* lisp/gnus/gnus-util.el (print-string-length)
(iswitchb-make-buflist-hook): Declare vars.
(gnus-emacs-version): Remove unused var `codename`.
(gnus-rename-file): Remove unused vars `old-name` and `new-name`.
* lisp/gnus/gnus-uu.el (gnus-uu-yenc-article): Remove unused var
`start-char`.
(gnus-asynchronous): Declare var.
* lisp/gnus/mm-partial.el (gnus-displaying-mime): Declare var.
(mm-inline-partial): Remove unused var `buffer`.
* lisp/gnus/mm-view.el (w3m-force-redisplay, w3m-safe-url-regexp)
(gnus-displaying-mime, gnus-original-article-buffer)
(gnus-article-prepare-hook): Declare vars.
* lisp/gnus/mml-smime.el (mml-smime-epg-encrypt): Remove unused var
`boundary`.
(mml-smime-epg-verify): Remove unused vars `plain` and `signature-file`.
* lisp/gnus/mml1991.el (pgg-text-mode): Declare var.
* lisp/gnus/mml2015.el (pgg-text-mode): Declare var.
(mml2015-pgg-decrypt): Remove unused var `result`.
(mml2015-epg-key-image-to-string): Remove unused var `error`.
(mml2015-epg-decrypt): Remove unused var `result`.
(mml2015-epg-verify): Remove unused vars `plain` and `signature-file`.
* lisp/gnus/nnbabyl.el (nnml-current-directory): Declare var.
* lisp/gnus/nndiary.el (nndiary-files): Move declaration before first use.
* lisp/gnus/nnfolder.el (nnfolder-request-accept-article):
Remove unused var `buf`.
* lisp/gnus/nnmail.el (nnmail-parse-active): Remove unused var `err`.
* lisp/gnus/nnmairix.el (nnmairix-request-group): Remove unused var `args`.
(nnmairix-request-create-group): Remove unused var `info`.
(nnmairix-request-list): Remove unused var `folder`.
(nnmairix-request-set-mark): Remove unused var `propto`.
(nnmairix-request-set-mark): Remove unused vars `number` and `method`.
(nnmairix-close-group): Remove unused var `method`.
(nnmairix-create-search-group-from-message): Remove unused var `cq`.
(nnmairix-create-server-and-default-group): Remove unused var `create`.
(nnmairix-purge-old-groups): Remove unused var `folder`.
(nnmairix-remove-tick-mark-original-article, nnmairix-get-valid-servers):
Remove unused var `cur`.
(nnmairix-replace-group-and-numbers): Remove unused var `header`.
(nnmairix-goto-original-article): Remove unused var `rval`.
(nnmairix-widget-create-query): Remove unused var `allwidgets`.
* lisp/gnus/nnmbox.el (nnml-current-directory): Declare var.
* lisp/gnus/nnmh.el (nnmh-toplev): Move declaration before first use.
(nnmh-request-list-1): Remove unused var `rdir`.
* lisp/gnus/nnml.el (nnml-generate-nov-file): Remove unused var `file`.
* lisp/gnus/nnrss.el (nnrss-request-article): Remove unused var `post`.
(nnrss-request-article): Remove unused var `fn`.
(nnrss-check-group): Remove unused var `rdf-ns`.
* lisp/gnus/nnweb.el (nnweb-request-article): Remove unused var `active`.
(nnweb-google-parse-1): Remove unused var `Score`.
* lisp/gnus/spam-stat.el (spam-stat-error-holder): Remove var.
(spam-stat-buffer-words-with-scores): Remove unused var `word`.
(spam-stat-score-buffer): Remove unused var `spam-stat-error-holder`.
(spam-stat-split-fancy): Use `err` instead of `spam-stat-error-holder`.
* lisp/gnus/spam-wash.el (spam-wash): Remove unused var `handle`.
* lisp/gnus/spam.el (spam-copy-or-move-routine): Remove unused vars
`article` and `mark`.
(spam-register-routine): Remove unused var `article`.
(spam-log-undo-registration): Remove unused var `found`.
(spam-ifile-register-with-ifile): Remove unused var `parameters`.
(spam-check-stat): Remove unused vars `category` and `return`.
(spam-parse-list): Remove unused var `found`.
(spam-filelist-register-routine): Remove unused var `from`.
This commit is contained in:
Stefan Monnier 2021-01-30 18:44:00 -05:00
parent 9be4f41b42
commit daa4e0120d
90 changed files with 774 additions and 661 deletions
Download patch file Download diff file Expand all files Collapse all files

2
lisp/gnus/canlock.el
View file

@ -1,4 +1,4 @@
;;; canlock.el --- functions for Cancel-Lock feature ;;; canlock.el --- functions for Cancel-Lock feature -*- lexical-binding: t; -*-
;; Copyright (C) 1998-1999, 2001-2021 Free Software Foundation, Inc. ;; Copyright (C) 1998-1999, 2001-2021 Free Software Foundation, Inc.

5
lisp/gnus/deuglify.el
View file

@ -1,4 +1,4 @@
;;; deuglify.el --- deuglify broken Outlook (Express) articles ;;; deuglify.el --- deuglify broken Outlook (Express) articles -*- lexical-binding: t; -*-
;; Copyright (C) 2001-2021 Free Software Foundation, Inc. ;; Copyright (C) 2001-2021 Free Software Foundation, Inc.
@ -336,7 +336,8 @@ NODISPLAY is non-nil, don't redisplay the article buffer."
"Put text from ATTR-START to the end of buffer at the top of the article buffer." "Put text from ATTR-START to the end of buffer at the top of the article buffer."
;; FIXME: 1. (*) text/plain ( ) text/html ;; FIXME: 1. (*) text/plain ( ) text/html
(let ((inhibit-read-only t) (let ((inhibit-read-only t)
(cite-marks gnus-outlook-deuglify-cite-marks)) ;; (cite-marks gnus-outlook-deuglify-cite-marks)
)
(gnus-with-article-buffer (gnus-with-article-buffer
(article-goto-body) (article-goto-body)
;; article does not start with attribution ;; article does not start with attribution

2
lisp/gnus/gmm-utils.el
View file

@ -1,4 +1,4 @@
;;; gmm-utils.el --- Utility functions for Gnus, Message and MML ;;; gmm-utils.el --- Utility functions for Gnus, Message and MML -*- lexical-binding: t; -*-
;; Copyright (C) 2006-2021 Free Software Foundation, Inc. ;; Copyright (C) 2006-2021 Free Software Foundation, Inc.

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

@ -1,4 +1,4 @@
;;; gnus-agent.el --- unplugged support for Gnus ;;; gnus-agent.el --- unplugged support for Gnus -*- lexical-binding: t; -*-
;; Copyright (C) 1997-2021 Free Software Foundation, Inc. ;; Copyright (C) 1997-2021 Free Software Foundation, Inc.
@ -820,7 +820,7 @@ be a select method."
(condition-case err (condition-case err
(while t (while t
(let ((bgn (point))) (let ((bgn (point)))
(eval (read (current-buffer))) (eval (read (current-buffer)) t)
(delete-region bgn (point)))) (delete-region bgn (point))))
(end-of-file (end-of-file
(delete-file (gnus-agent-lib-file "flags"))) (delete-file (gnus-agent-lib-file "flags")))
@ -2666,7 +2666,7 @@ The following commands are available:
(point) (point)
(prog1 (1+ (point)) (prog1 (1+ (point))
;; Insert the text. ;; Insert the text.
(eval gnus-category-line-format-spec)) (eval gnus-category-line-format-spec t))
(list 'gnus-category gnus-tmp-name)))) (list 'gnus-category gnus-tmp-name))))
(defun gnus-enter-category-buffer () (defun gnus-enter-category-buffer ()

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

@ -1,4 +1,4 @@
;;; gnus-art.el --- article mode commands for Gnus ;;; gnus-art.el --- article mode commands for Gnus -*- lexical-binding: t; -*-
;; Copyright (C) 1996-2021 Free Software Foundation, Inc. ;; Copyright (C) 1996-2021 Free Software Foundation, Inc.
@ -1432,7 +1432,7 @@ See Info node `(gnus)Customizing Articles' and Info node
(message "\ (message "\
** gnus-treat-display-xface is an obsolete variable;\ ** gnus-treat-display-xface is an obsolete variable;\
use gnus-treat-display-x-face instead") use gnus-treat-display-x-face instead")
(eval (car (get 'gnus-treat-display-xface 'saved-value)))) (eval (car (get 'gnus-treat-display-xface 'saved-value)) t))
(t (t
value))))) value)))))
(put 'gnus-treat-display-x-face 'highlight t) (put 'gnus-treat-display-x-face 'highlight t)
@ -2162,6 +2162,8 @@ MAP is an alist where the elements are on the form (\"from\" \"to\")."
(put-text-property (put-text-property
(point) (1+ (point)) 'face 'underline))))))))) (point) (1+ (point)) 'face 'underline)))))))))
(defvar ansi-color-context-region)
(defun article-treat-ansi-sequences () (defun article-treat-ansi-sequences ()
"Translate ANSI SGR control sequences into overlays or extents." "Translate ANSI SGR control sequences into overlays or extents."
(interactive) (interactive)
@ -2893,7 +2895,7 @@ message header will be added to the bodies of the \"text/html\" parts."
(t "<br>\n")))) (t "<br>\n"))))
(goto-char (point-min)) (goto-char (point-min))
(while (re-search-forward "^[\t ]+" nil t) (while (re-search-forward "^[\t ]+" nil t)
(dotimes (i (prog1 (dotimes (_ (prog1
(current-column) (current-column)
(delete-region (match-beginning 0) (delete-region (match-beginning 0)
(match-end 0)))) (match-end 0))))
@ -3021,6 +3023,8 @@ message header will be added to the bodies of the \"text/html\" parts."
(setq showed t))))) (setq showed t)))))
showed)) showed))
(defvar gnus-mime-display-attachment-buttons-in-header)
(defun gnus-article-browse-html-article (&optional arg) (defun gnus-article-browse-html-article (&optional arg)
"View \"text/html\" parts of the current article with a WWW browser. "View \"text/html\" parts of the current article with a WWW browser.
Inline images embedded in a message using the cid scheme, as they are Inline images embedded in a message using the cid scheme, as they are
@ -4712,8 +4716,6 @@ If ALL-HEADERS is non-nil, no headers are hidden."
(gnus-run-hooks 'gnus-article-prepare-hook) (gnus-run-hooks 'gnus-article-prepare-hook)
t)))))) t))))))
(defvar gnus-mime-display-attachment-buttons-in-header)
;;;###autoload ;;;###autoload
(defun gnus-article-prepare-display () (defun gnus-article-prepare-display ()
"Make the current buffer look like a nice article." "Make the current buffer look like a nice article."
@ -6149,7 +6151,7 @@ If nil, don't show those extra buttons."
(let* ((preferred (or preferred (mm-preferred-alternative handles))) (let* ((preferred (or preferred (mm-preferred-alternative handles)))
(ihandles handles) (ihandles handles)
(point (point)) (point (point))
handle (inhibit-read-only t) from begend not-pref) handle (inhibit-read-only t) begend not-pref) ;; from
(save-window-excursion (save-window-excursion
(save-restriction (save-restriction
(when ibegend (when ibegend
@ -6170,7 +6172,8 @@ If nil, don't show those extra buttons."
(not (gnus-unbuttonized-mime-type-p (not (gnus-unbuttonized-mime-type-p
"multipart/alternative"))) "multipart/alternative")))
(add-text-properties (add-text-properties
(setq from (point)) ;; (setq from
(point);; )
(progn (progn
(insert (format "%d. " id)) (insert (format "%d. " id))
(point)) (point))
@ -6191,7 +6194,8 @@ If nil, don't show those extra buttons."
;; Do the handles ;; Do the handles
(while (setq handle (pop handles)) (while (setq handle (pop handles))
(add-text-properties (add-text-properties
(setq from (point)) ;; (setq from
(point) ;; )
(progn (progn
(insert (format "(%c) %-18s" (insert (format "(%c) %-18s"
(if (equal handle preferred) ?* ? ) (if (equal handle preferred) ?* ? )
@ -7986,13 +7990,13 @@ specified by `gnus-button-alist'."
(article-goto-body) (article-goto-body)
(setq beg (point)) (setq beg (point))
(while (setq entry (pop alist)) (while (setq entry (pop alist))
(setq regexp (eval (car entry))) (setq regexp (eval (car entry) t))
(goto-char beg) (goto-char beg)
(while (re-search-forward regexp nil t) (while (re-search-forward regexp nil t)
(let ((start (match-beginning (nth 1 entry))) (let ((start (match-beginning (nth 1 entry)))
(end (match-end (nth 1 entry))) (end (match-end (nth 1 entry)))
(from (match-beginning 0))) (from (match-beginning 0)))
(when (and (eval (nth 2 entry)) (when (and (eval (nth 2 entry) t)
(not (gnus-button-in-region-p (not (gnus-button-in-region-p
start end 'gnus-callback))) start end 'gnus-callback)))
;; That optional form returned non-nil, so we add the ;; That optional form returned non-nil, so we add the
@ -8083,14 +8087,14 @@ url is put as the `gnus-button-url' overlay property on the button."
(match-beginning 0)) (match-beginning 0))
(point-max))) (point-max)))
(goto-char beg) (goto-char beg)
(while (re-search-forward (eval (nth 1 entry)) end t) (while (re-search-forward (eval (nth 1 entry) t) end t)
;; Each match within a header. ;; Each match within a header.
(let* ((entry (cdr entry)) (let* ((entry (cdr entry))
(start (match-beginning (nth 1 entry))) (start (match-beginning (nth 1 entry)))
(end (match-end (nth 1 entry))) (end (match-end (nth 1 entry)))
(form (nth 2 entry))) (form (nth 2 entry)))
(goto-char (match-end 0)) (goto-char (match-end 0))
(when (eval form) (when (eval form t)
(gnus-article-add-button (gnus-article-add-button
start end (nth 3 entry) start end (nth 3 entry)
(buffer-substring (match-beginning (nth 4 entry)) (buffer-substring (match-beginning (nth 4 entry))
@ -8099,7 +8103,7 @@ url is put as the `gnus-button-url' overlay property on the button."
;;; External functions: ;;; External functions:
(defun gnus-article-add-button (from to fun &optional data text) (defun gnus-article-add-button (from to fun &optional data _text)
"Create a button between FROM and TO with callback FUN and data DATA." "Create a button between FROM and TO with callback FUN and data DATA."
(add-text-properties (add-text-properties
from to from to
@ -8312,7 +8316,7 @@ url is put as the `gnus-button-url' overlay property on the button."
(setq indx (match-string 1 indx)) (setq indx (match-string 1 indx))
(Info-index indx) (Info-index indx)
(when comma (when comma
(dotimes (i (with-temp-buffer (dotimes (_ (with-temp-buffer
(insert comma) (insert comma)
;; Note: the XEmacs version of `how-many' takes ;; Note: the XEmacs version of `how-many' takes
;; no optional argument. ;; no optional argument.

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

@ -1,4 +1,4 @@
;;; gnus-bcklg.el --- backlog functions for Gnus ;;; gnus-bcklg.el --- backlog functions for Gnus -*- lexical-binding: t; -*-
;; Copyright (C) 1996-2021 Free Software Foundation, Inc. ;; Copyright (C) 1996-2021 Free Software Foundation, Inc.

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

@ -1,4 +1,4 @@
;;; gnus-bookmark.el --- Bookmarks in Gnus ;;; gnus-bookmark.el --- Bookmarks in Gnus -*- lexical-binding: t; -*-
;; Copyright (C) 2006-2021 Free Software Foundation, Inc. ;; Copyright (C) 2006-2021 Free Software Foundation, Inc.
@ -350,7 +350,7 @@ deletion, or > if it is flagged for displaying."
(switch-to-buffer (gnus-get-buffer-create "*Gnus Bookmark List*")) (switch-to-buffer (gnus-get-buffer-create "*Gnus Bookmark List*"))
(set-buffer (gnus-get-buffer-create "*Gnus Bookmark List*"))) (set-buffer (gnus-get-buffer-create "*Gnus Bookmark List*")))
(let ((inhibit-read-only t) (let ((inhibit-read-only t)
alist name start end) alist name) ;; start end
(erase-buffer) (erase-buffer)
(insert "% Gnus Bookmark\n- --------\n") (insert "% Gnus Bookmark\n- --------\n")
(add-text-properties (point-min) (point) (add-text-properties (point-min) (point)

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

@ -1,4 +1,4 @@
;;; gnus-cache.el --- cache interface for Gnus ;;; gnus-cache.el --- cache interface for Gnus -*- lexical-binding: t; -*-
;; Copyright (C) 1995-2021 Free Software Foundation, Inc. ;; Copyright (C) 1995-2021 Free Software Foundation, Inc.
@ -148,6 +148,8 @@ it's not cached."
(gnus-kill-buffer buffer) (gnus-kill-buffer buffer)
(setq gnus-cache-buffer nil)))) (setq gnus-cache-buffer nil))))
(defvar gnus-article-decode-hook)
(defun gnus-cache-possibly-enter-article (defun gnus-cache-possibly-enter-article
(group article ticked dormant unread &optional force) (group article ticked dormant unread &optional force)
(when (and (or force (not (eq gnus-use-cache 'passive))) (when (and (or force (not (eq gnus-use-cache 'passive)))
@ -728,6 +730,8 @@ If LOW, update the lower bound instead."
(gnus-cache-write-active t) (gnus-cache-write-active t)
(gnus-message 5 "Generating the cache active file...done")))) (gnus-message 5 "Generating the cache active file...done"))))
(defvar nnml-generate-active-function)
;;;###autoload ;;;###autoload
(defun gnus-cache-generate-nov-databases (dir) (defun gnus-cache-generate-nov-databases (dir)
"Generate NOV files recursively starting in DIR." "Generate NOV files recursively starting in DIR."

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

@ -1,4 +1,4 @@
;;; gnus-cite.el --- parse citations in articles for Gnus ;;; gnus-cite.el --- parse citations in articles for Gnus -*- lexical-binding: t; -*-
;; Copyright (C) 1995-2021 Free Software Foundation, Inc. ;; Copyright (C) 1995-2021 Free Software Foundation, Inc.
@ -524,7 +524,7 @@ text (i.e., computer code and the like) will not be folded."
;; like code? Check for ragged edges on the left. ;; like code? Check for ragged edges on the left.
(< (length columns) 3)))) (< (length columns) 3))))
(defun gnus-article-hide-citation (&optional arg force) (defun gnus-article-hide-citation (&optional arg _force)
"Toggle hiding of all cited text except attribution lines. "Toggle hiding of all cited text except attribution lines.
See the documentation for `gnus-article-highlight-citation'. See the documentation for `gnus-article-highlight-citation'.
If given a negative prefix, always show; if given a positive prefix, If given a negative prefix, always show; if given a positive prefix,
@ -594,7 +594,7 @@ always hide."
(progn (progn
(gnus-article-add-button (gnus-article-add-button
(point) (point)
(progn (eval gnus-cited-closed-text-button-line-format-spec) (progn (eval gnus-cited-closed-text-button-line-format-spec t)
(point)) (point))
'gnus-article-toggle-cited-text 'gnus-article-toggle-cited-text
(list (cons beg end) start)) (list (cons beg end) start))
@ -644,7 +644,8 @@ means show, nil means toggle."
(progn (eval (progn (eval
(if hidden (if hidden
gnus-cited-opened-text-button-line-format-spec gnus-cited-opened-text-button-line-format-spec
gnus-cited-closed-text-button-line-format-spec)) gnus-cited-closed-text-button-line-format-spec)
t)
(point)) (point))
'gnus-article-toggle-cited-text 'gnus-article-toggle-cited-text
args) args)
@ -697,7 +698,7 @@ See also the documentation for `gnus-article-highlight-citation'."
;;; Internal functions: ;;; Internal functions:
(defun gnus-cite-parse-maybe (&optional force no-overlay) (defun gnus-cite-parse-maybe (&optional _force no-overlay)
"Always parse the buffer." "Always parse the buffer."
(gnus-cite-localize) (gnus-cite-localize)
;;Reset parser information. ;;Reset parser information.
@ -890,25 +891,25 @@ See also the documentation for `gnus-article-highlight-citation'."
(regexp-quote tag) ">")))) (regexp-quote tag) ">"))))
;; Find loose supercite citations after attributions. ;; Find loose supercite citations after attributions.
(gnus-cite-match-attributions 'small t (gnus-cite-match-attributions 'small t
(lambda (prefix tag) (lambda (_prefix tag)
(when tag (when tag
(concat "\\<" (concat "\\<"
(regexp-quote tag) (regexp-quote tag)
"\\>")))) "\\>"))))
;; Find loose supercite citations anywhere. ;; Find loose supercite citations anywhere.
(gnus-cite-match-attributions 'small nil (gnus-cite-match-attributions 'small nil
(lambda (prefix tag) (lambda (_prefix tag)
(when tag (when tag
(concat "\\<" (concat "\\<"
(regexp-quote tag) (regexp-quote tag)
"\\>")))) "\\>"))))
;; Find nested citations after attributions. ;; Find nested citations after attributions.
(gnus-cite-match-attributions 'small-if-unique t (gnus-cite-match-attributions 'small-if-unique t
(lambda (prefix tag) (lambda (prefix _tag)
(concat "\\`" (regexp-quote prefix) ".+"))) (concat "\\`" (regexp-quote prefix) ".+")))
;; Find nested citations anywhere. ;; Find nested citations anywhere.
(gnus-cite-match-attributions 'small nil (gnus-cite-match-attributions 'small nil
(lambda (prefix tag) (lambda (prefix _tag)
(concat "\\`" (regexp-quote prefix) ".+"))) (concat "\\`" (regexp-quote prefix) ".+")))
;; Remove loose prefixes with too few lines. ;; Remove loose prefixes with too few lines.
(let ((alist gnus-cite-loose-prefix-alist) (let ((alist gnus-cite-loose-prefix-alist)
@ -1137,7 +1138,7 @@ When enabled, it automatically turns on `font-lock-mode'."
(when (derived-mode-p 'message-mode) (when (derived-mode-p 'message-mode)
;; FIXME: Use font-lock-add-keywords! ;; FIXME: Use font-lock-add-keywords!
(let ((defaults (car font-lock-defaults)) (let ((defaults (car font-lock-defaults))
default keywords) default) ;; keywords
(while defaults (while defaults
(setq default (if (consp defaults) (setq default (if (consp defaults)
(pop defaults) (pop defaults)

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

@ -1,4 +1,4 @@
;;; gnus-cloud.el --- storing and retrieving data via IMAP ;;; gnus-cloud.el --- storing and retrieving data via IMAP -*- lexical-binding: t; -*-
;; Copyright (C) 2014-2021 Free Software Foundation, Inc. ;; Copyright (C) 2014-2021 Free Software Foundation, Inc.
@ -128,7 +128,7 @@ easy interactive way to set this from the Server buffer."
((eq gnus-cloud-storage-method 'epg) ((eq gnus-cloud-storage-method 'epg)
(let ((context (epg-make-context 'OpenPGP)) (let ((context (epg-make-context 'OpenPGP))
cipher) ) ;; cipher
(setf (epg-context-armor context) t) (setf (epg-context-armor context) t)
(setf (epg-context-textmode context) t) (setf (epg-context-textmode context) t)
(let ((data (epg-encrypt-string context (let ((data (epg-encrypt-string context
@ -344,15 +344,15 @@ easy interactive way to set this from the Server buffer."
(group &optional previous method)) (group &optional previous method))
(defun gnus-cloud-ensure-cloud-group () (defun gnus-cloud-ensure-cloud-group ()
(let ((method (if (stringp gnus-cloud-method) ;; (let ((method (if (stringp gnus-cloud-method)
(gnus-server-to-method gnus-cloud-method) ;; (gnus-server-to-method gnus-cloud-method)
gnus-cloud-method))) ;; gnus-cloud-method)))
(unless (or (gnus-active gnus-cloud-group-name) (unless (or (gnus-active gnus-cloud-group-name)
(gnus-activate-group gnus-cloud-group-name nil nil (gnus-activate-group gnus-cloud-group-name nil nil
gnus-cloud-method)) gnus-cloud-method))
(and (gnus-request-create-group gnus-cloud-group-name gnus-cloud-method) (and (gnus-request-create-group gnus-cloud-group-name gnus-cloud-method)
(gnus-activate-group gnus-cloud-group-name nil nil gnus-cloud-method) (gnus-activate-group gnus-cloud-group-name nil nil gnus-cloud-method)
(gnus-subscribe-group gnus-cloud-group-name))))) (gnus-subscribe-group gnus-cloud-group-name)))) ;; )
(defun gnus-cloud-upload-all-data () (defun gnus-cloud-upload-all-data ()
"Upload all data (newsrc and files) to the Gnus Cloud." "Upload all data (newsrc and files) to the Gnus Cloud."

11
lisp/gnus/gnus-cus.el
View file

@ -1,4 +1,4 @@
;;; gnus-cus.el --- customization commands for Gnus ;;; gnus-cus.el --- customization commands for Gnus -*- lexical-binding: t; -*-
;; Copyright (C) 1996, 1999-2021 Free Software Foundation, Inc. ;; Copyright (C) 1996, 1999-2021 Free Software Foundation, Inc.
@ -483,7 +483,7 @@ form, but who cares?"
(buffer-enable-undo) (buffer-enable-undo)
(goto-char (point-min)))) (goto-char (point-min))))
(defun gnus-group-customize-done (&rest ignore) (defun gnus-group-customize-done (&rest _ignore)
"Apply changes and bury the buffer." "Apply changes and bury the buffer."
(interactive) (interactive)
(let ((params (widget-value gnus-custom-params))) (let ((params (widget-value gnus-custom-params)))
@ -927,7 +927,7 @@ articles in the thread.
(use-local-map widget-keymap) (use-local-map widget-keymap)
(widget-setup))) (widget-setup)))
(defun gnus-score-customize-done (&rest ignore) (defun gnus-score-customize-done (&rest _ignore)
"Reset the score alist with the present value." "Reset the score alist with the present value."
(let ((alist gnus-custom-score-alist) (let ((alist gnus-custom-score-alist)
(value (widget-value gnus-custom-scores))) (value (widget-value gnus-custom-scores)))
@ -1027,14 +1027,15 @@ articles in the thread.
(widget-create (widget-create
'push-button 'push-button
:notify :notify
(lambda (&rest ignore) (lambda (&rest _ignore)
(let* ((info (assq gnus-agent-cat-name gnus-category-alist)) (let* ((info (assq gnus-agent-cat-name gnus-category-alist))
(widgets category-fields)) (widgets category-fields))
(while widgets (while widgets
(let* ((widget (pop widgets)) (let* ((widget (pop widgets))
(value (condition-case nil (widget-value widget) (error)))) (value (condition-case nil (widget-value widget) (error))))
(eval `(setf (,(widget-get widget :accessor) ',info) (eval `(setf (,(widget-get widget :accessor) ',info)
',value))))) ',value)
t))))
(gnus-category-write) (gnus-category-write)
(gnus-kill-buffer (current-buffer)) (gnus-kill-buffer (current-buffer))
(when (get-buffer gnus-category-buffer) (when (get-buffer gnus-category-buffer)

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

@ -1,4 +1,4 @@
;;; gnus-delay.el --- Delayed posting of articles ;;; gnus-delay.el --- Delayed posting of articles -*- lexical-binding: t; -*-
;; Copyright (C) 2001-2021 Free Software Foundation, Inc. ;; Copyright (C) 2001-2021 Free Software Foundation, Inc.
@ -82,7 +82,7 @@ generated when the article is sent."
gnus-delay-default-delay))) gnus-delay-default-delay)))
;; Allow spell checking etc. ;; Allow spell checking etc.
(run-hooks 'message-send-hook) (run-hooks 'message-send-hook)
(let (num unit days year month day hour minute deadline) (let (num unit year month day hour minute deadline) ;; days
(cond ((string-match (cond ((string-match
"\\([0-9][0-9][0-9]?[0-9]?\\)-\\([0-9]+\\)-\\([0-9]+\\)" "\\([0-9][0-9][0-9]?[0-9]?\\)-\\([0-9]+\\)-\\([0-9]+\\)"
delay) delay)
@ -167,7 +167,7 @@ generated when the article is sent."
(message "Delay header missing for article %d" article))))))) (message "Delay header missing for article %d" article)))))))
;;;###autoload ;;;###autoload
(defun gnus-delay-initialize (&optional no-keymap no-check) (defun gnus-delay-initialize (&optional _no-keymap no-check)
"Initialize the gnus-delay package. "Initialize the gnus-delay package.
This sets up a key binding in `message-mode' to delay a message. This sets up a key binding in `message-mode' to delay a message.
This tells Gnus to look for delayed messages after getting new news. This tells Gnus to look for delayed messages after getting new news.

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

@ -1,4 +1,4 @@
;;; gnus-demon.el --- daemonic Gnus behavior ;;; gnus-demon.el --- daemonic Gnus behavior -*- lexical-binding: t; -*-
;; Copyright (C) 1995-2021 Free Software Foundation, Inc. ;; Copyright (C) 1995-2021 Free Software Foundation, Inc.

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

@ -1,4 +1,4 @@
;;; gnus-diary.el --- Wrapper around the NNDiary Gnus back end ;;; gnus-diary.el --- Wrapper around the NNDiary Gnus back end -*- lexical-binding: t; -*-
;; Copyright (C) 1999-2021 Free Software Foundation, Inc. ;; Copyright (C) 1999-2021 Free Software Foundation, Inc.

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

@ -1,4 +1,4 @@
;;; gnus-dired.el --- utility functions where gnus and dired meet ;;; gnus-dired.el --- utility functions where gnus and dired meet -*- lexical-binding: t; -*-
;; Copyright (C) 1996-1999, 2001-2021 Free Software Foundation, Inc. ;; Copyright (C) 1996-1999, 2001-2021 Free Software Foundation, Inc.

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

@ -1,4 +1,4 @@
;;; gnus-draft.el --- draft message support for Gnus ;;; gnus-draft.el --- draft message support for Gnus -*- lexical-binding: t; -*-
;; Copyright (C) 1997-2021 Free Software Foundation, Inc. ;; Copyright (C) 1997-2021 Free Software Foundation, Inc.

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

@ -1,4 +1,4 @@
;;; gnus-eform.el --- a mode for editing forms for Gnus ;;; gnus-eform.el --- a mode for editing forms for Gnus -*- lexical-binding: t; -*-
;; Copyright (C) 1996-2021 Free Software Foundation, Inc. ;; Copyright (C) 1996-2021 Free Software Foundation, Inc.

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

@ -1,4 +1,4 @@
;;; gnus-fun.el --- various frivolous extension functions to Gnus ;;; gnus-fun.el --- various frivolous extension functions to Gnus -*- lexical-binding: t; -*-
;; Copyright (C) 2002-2021 Free Software Foundation, Inc. ;; Copyright (C) 2002-2021 Free Software Foundation, Inc.

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

@ -1,4 +1,4 @@
;;; gnus-group.el --- group mode commands for Gnus ;;; gnus-group.el --- group mode commands for Gnus -*- lexical-binding: t; -*-
;; Copyright (C) 1996-2021 Free Software Foundation, Inc. ;; Copyright (C) 1996-2021 Free Software Foundation, Inc.
@ -39,8 +39,9 @@
(eval-when-compile (eval-when-compile
(require 'mm-url) (require 'mm-url)
(require 'subr-x) (require 'subr-x)
(let ((features (cons 'gnus-group features))) (with-suppressed-warnings ((lexical features))
(require 'gnus-sum))) (dlet ((features (cons 'gnus-group features)))
(require 'gnus-sum))))
(defvar gnus-cache-active-hashtb) (defvar gnus-cache-active-hashtb)
@ -476,6 +477,9 @@ simple manner."
(defvar gnus-group-edit-buffer nil) (defvar gnus-group-edit-buffer nil)
(defvar gnus-tmp-group)
(defvar gnus-tmp-level)
(defvar gnus-tmp-marked)
(defvar gnus-tmp-news-method) (defvar gnus-tmp-news-method)
(defvar gnus-tmp-colon) (defvar gnus-tmp-colon)
(defvar gnus-tmp-news-server) (defvar gnus-tmp-news-server)
@ -1499,11 +1503,15 @@ if it is a string, only list groups matching REGEXP."
(gnus-group-get-new-news 0)))) (gnus-group-get-new-news 0))))
:type 'boolean) :type 'boolean)
(defun gnus-group-insert-group-line (gnus-tmp-group gnus-tmp-level (defun gnus-group-insert-group-line (group level marked number gnus-tmp-method)
gnus-tmp-marked number
gnus-tmp-method)
"Insert a group line in the group buffer." "Insert a group line in the group buffer."
(let* ((gnus-tmp-method (with-suppressed-warnings ((lexical number))
(defvar number)) ;FIXME: Used in `gnus-group-line-format-alist'.
(let* ((number number)
(gnus-tmp-level level)
(gnus-tmp-marked marked)
(gnus-tmp-group group)
(gnus-tmp-method
(gnus-server-get-method gnus-tmp-group gnus-tmp-method)) (gnus-server-get-method gnus-tmp-group gnus-tmp-method))
(gnus-tmp-active (gnus-active gnus-tmp-group)) (gnus-tmp-active (gnus-active gnus-tmp-group))
(gnus-tmp-number-total (gnus-tmp-number-total
@ -1567,7 +1575,7 @@ if it is a string, only list groups matching REGEXP."
(point) (point)
(prog1 (1+ (point)) (prog1 (1+ (point))
;; Insert the text. ;; Insert the text.
(eval gnus-group-line-format-spec)) (eval gnus-group-line-format-spec t))
`(gnus-group ,gnus-tmp-group `(gnus-group ,gnus-tmp-group
gnus-unread ,(if (numberp number) gnus-unread ,(if (numberp number)
(string-to-number gnus-tmp-number-of-unread) (string-to-number gnus-tmp-number-of-unread)
@ -1738,7 +1746,7 @@ already. If INFO-UNCHANGED is non-nil, dribble buffer is not updated."
(buffer-modified-p gnus-dribble-buffer) (buffer-modified-p gnus-dribble-buffer)
(with-current-buffer gnus-dribble-buffer (with-current-buffer gnus-dribble-buffer
(not (zerop (buffer-size)))))) (not (zerop (buffer-size))))))
(mode-string (eval gformat))) (mode-string (eval gformat t)))
;; Say whether the dribble buffer has been modified. ;; Say whether the dribble buffer has been modified.
(setq mode-line-modified (setq mode-line-modified
(if modified "**" "--")) (if modified "**" "--"))
@ -1934,7 +1942,7 @@ Return nil if the group isn't displayed."
(gnus-group-mark-group 1 nil t)) (gnus-group-mark-group 1 nil t))
(setq gnus-group-marked (cons group (delete group gnus-group-marked))))) (setq gnus-group-marked (cons group (delete group gnus-group-marked)))))
(defun gnus-group-universal-argument (arg &optional groups func) (defun gnus-group-universal-argument (arg &optional _groups func)
"Perform any command on all groups according to the process/prefix convention." "Perform any command on all groups according to the process/prefix convention."
(interactive "P") (interactive "P")
(if (eq (setq func (or func (if (eq (setq func (or func
@ -1945,7 +1953,7 @@ Return nil if the group isn't displayed."
'undefined) 'undefined)
(gnus-error 1 "Undefined key") (gnus-error 1 "Undefined key")
(gnus-group-iterate arg (gnus-group-iterate arg
(lambda (group) (lambda (_group)
(command-execute func)))) (command-execute func))))
(gnus-group-position-point)) (gnus-group-position-point))
@ -2054,6 +2062,12 @@ articles in the group."
(forward-line -1)) (forward-line -1))
(gnus-group-read-group all t)) (gnus-group-read-group all t))
(defvar gnus-visual)
(defvar gnus-score-find-score-files-function)
(defvar gnus-home-score-file)
(defvar gnus-apply-kill-hook)
(defvar gnus-summary-expunge-below)
(defun gnus-group-quick-select-group (&optional all group) (defun gnus-group-quick-select-group (&optional all group)
"Select the GROUP \"quickly\". "Select the GROUP \"quickly\".
This means that no highlighting or scoring will be performed. If This means that no highlighting or scoring will be performed. If
@ -2511,7 +2525,7 @@ The arguments have the same meaning as those of
(if (stringp id) (setq id (string-to-number id))) (if (stringp id) (setq id (string-to-number id)))
(setq-local debbugs-gnu-bug-number id))))) (setq-local debbugs-gnu-bug-number id)))))
(defun gnus-group-jump-to-group (group &optional prompt) (defun gnus-group-jump-to-group (group &optional _prompt)
"Jump to newsgroup GROUP. "Jump to newsgroup GROUP.
If PROMPT (the prefix) is a number, use the prompt specified in If PROMPT (the prefix) is a number, use the prompt specified in
@ -2985,7 +2999,7 @@ and NEW-NAME will be prompted for."
(setq method (copy-tree method)) (setq method (copy-tree method))
(let (entry) (let (entry)
(while (setq entry (memq (assq 'eval method) method)) (while (setq entry (memq (assq 'eval method) method))
(setcar entry (eval (cadar entry))))) (setcar entry (eval (cadar entry) t))))
(gnus-group-make-group group method)) (gnus-group-make-group group method))
(defun gnus-group-make-help-group (&optional noerror) (defun gnus-group-make-help-group (&optional noerror)
@ -4317,9 +4331,9 @@ If FORCE, force saving whether it is necessary or not."
(interactive "P") (interactive "P")
(gnus-save-newsrc-file force)) (gnus-save-newsrc-file force))
(defun gnus-group-restart (&optional arg) (defun gnus-group-restart (&optional _arg)
"Force Gnus to read the .newsrc file." "Force Gnus to read the .newsrc file."
(interactive "P") (interactive)
(when (gnus-yes-or-no-p (when (gnus-yes-or-no-p
(format "Are you sure you want to restart Gnus? ")) (format "Are you sure you want to restart Gnus? "))
(gnus-save-newsrc-file) (gnus-save-newsrc-file)
@ -4738,9 +4752,9 @@ This command may read the active file."
(forward-char 1)) (forward-char 1))
groups)) groups))
(defun gnus-group-list-plus (&optional args) (defun gnus-group-list-plus (&optional _args)
"List groups plus the current selection." "List groups plus the current selection."
(interactive "P") (interactive)
(let ((gnus-group-listed-groups (gnus-group-listed-groups)) (let ((gnus-group-listed-groups (gnus-group-listed-groups))
(gnus-group-list-mode gnus-group-list-mode) ;; Save it. (gnus-group-list-mode gnus-group-list-mode) ;; Save it.
func) func)

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

@ -1,4 +1,4 @@
;;; gnus-html.el --- Render HTML in a buffer. ;;; gnus-html.el --- Render HTML in a buffer. -*- lexical-binding: t; -*-
;; Copyright (C) 2010-2021 Free Software Foundation, Inc. ;; Copyright (C) 2010-2021 Free Software Foundation, Inc.
@ -151,8 +151,8 @@ fit these criteria."
(defun gnus-html-wash-images () (defun gnus-html-wash-images ()
"Run through current buffer and replace img tags by images." "Run through current buffer and replace img tags by images."
(let (tag parameters string start end images (let ( parameters start end ;; tag string images
inhibit-images blocked-images) inhibit-images blocked-images)
(if (buffer-live-p gnus-summary-buffer) (if (buffer-live-p gnus-summary-buffer)
(with-current-buffer gnus-summary-buffer (with-current-buffer gnus-summary-buffer
(setq inhibit-images gnus-inhibit-images (setq inhibit-images gnus-inhibit-images
@ -229,7 +229,7 @@ fit these criteria."
(> width 4))) (> width 4)))
(gnus-html-display-image url start end alt-text)))))))))) (gnus-html-display-image url start end alt-text))))))))))
(defun gnus-html-display-image (url start end &optional alt-text) (defun gnus-html-display-image (url _start _end &optional alt-text)
"Display image at URL on text from START to END. "Display image at URL on text from START to END.
Use ALT-TEXT for the image string." Use ALT-TEXT for the image string."
(or alt-text (setq alt-text "*")) (or alt-text (setq alt-text "*"))
@ -248,7 +248,7 @@ Use ALT-TEXT for the image string."
(gnus-html-put-image (gnus-html-get-image-data url) url alt-text)))) (gnus-html-put-image (gnus-html-get-image-data url) url alt-text))))
(defun gnus-html-wash-tags () (defun gnus-html-wash-tags ()
(let (tag parameters string start end images url) (let (tag parameters start end url) ;; string images
(gnus-html-pre-wash) (gnus-html-pre-wash)
(gnus-html-wash-images) (gnus-html-wash-images)

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

@ -1,4 +1,4 @@
;;; gnus-int.el --- backend interface functions for Gnus ;;; gnus-int.el --- backend interface functions for Gnus -*- lexical-binding: t; -*-
;; Copyright (C) 1996-2021 Free Software Foundation, Inc. ;; Copyright (C) 1996-2021 Free Software Foundation, Inc.
@ -76,23 +76,25 @@ server denied."
"The current method, for the registry.") "The current method, for the registry.")
(defun gnus-server-opened (gnus-command-method) (defun gnus-server-opened (command-method)
"Check whether a connection to GNUS-COMMAND-METHOD has been opened." "Check whether a connection to COMMAND-METHOD has been opened."
(unless (eq (gnus-server-status gnus-command-method) (unless (eq (gnus-server-status command-method)
'denied) 'denied)
(when (stringp gnus-command-method) (let ((gnus-command-method
(setq gnus-command-method (gnus-server-to-method gnus-command-method))) (if (stringp command-method)
(funcall (inline (gnus-get-function gnus-command-method 'server-opened)) (gnus-server-to-method command-method)
(nth 1 gnus-command-method)))) command-method)))
(funcall (inline (gnus-get-function gnus-command-method 'server-opened))
(nth 1 gnus-command-method)))))
(defun gnus-status-message (gnus-command-method) (defun gnus-status-message (command-method)
"Return the status message from GNUS-COMMAND-METHOD. "Return the status message from COMMAND-METHOD.
If GNUS-COMMAND-METHOD is a string, it is interpreted as a group If COMMAND-METHOD is a string, it is interpreted as a group name.
name. The method this group uses will be queried." The method this group uses will be queried."
(let ((gnus-command-method (let ((gnus-command-method
(if (stringp gnus-command-method) (if (stringp command-method)
(gnus-find-method-for-group gnus-command-method) (gnus-find-method-for-group command-method)
gnus-command-method))) command-method)))
(funcall (gnus-get-function gnus-command-method 'status-message) (funcall (gnus-get-function gnus-command-method 'status-message)
(nth 1 gnus-command-method)))) (nth 1 gnus-command-method))))
@ -265,13 +267,14 @@ If it is down, start it up (again)."
type form)) type form))
(setq gnus-backend-trace-elapsed (float-time))))) (setq gnus-backend-trace-elapsed (float-time)))))
(defun gnus-open-server (gnus-command-method) (defun gnus-open-server (command-method)
"Open a connection to GNUS-COMMAND-METHOD." "Open a connection to COMMAND-METHOD."
(when (stringp gnus-command-method)
(setq gnus-command-method (gnus-server-to-method gnus-command-method)))
(gnus-backend-trace :opening gnus-command-method) (gnus-backend-trace :opening gnus-command-method)
(let ((elem (assoc gnus-command-method gnus-opened-servers)) (let* ((gnus-command-method (if (stringp command-method)
(server (gnus-method-to-server-name gnus-command-method))) (gnus-server-to-method command-method)
command-method))
(elem (assoc gnus-command-method gnus-opened-servers))
(server (gnus-method-to-server-name gnus-command-method)))
;; If this method was previously denied, we just return nil. ;; If this method was previously denied, we just return nil.
(if (eq (nth 1 elem) 'denied) (if (eq (nth 1 elem) 'denied)
(progn (progn
@ -347,23 +350,27 @@ If it is down, start it up (again)."
(gnus-backend-trace :opened gnus-command-method) (gnus-backend-trace :opened gnus-command-method)
result))))) result)))))
(defun gnus-close-server (gnus-command-method) (defun gnus-close-server (command-method)
"Close the connection to GNUS-COMMAND-METHOD." "Close the connection to COMMAND-METHOD."
(when (stringp gnus-command-method) (let ((gnus-command-method
(setq gnus-command-method (gnus-server-to-method gnus-command-method))) (if (stringp command-method)
(prog1 (gnus-server-to-method command-method)
(funcall (gnus-get-function gnus-command-method 'close-server) command-method)))
(nth 1 gnus-command-method) (prog1
(nthcdr 2 gnus-command-method)) (funcall (gnus-get-function gnus-command-method 'close-server)
(when-let ((elem (assoc gnus-command-method gnus-opened-servers))) (nth 1 gnus-command-method)
(setf (nth 1 elem) 'closed)))) (nthcdr 2 gnus-command-method))
(when-let ((elem (assoc gnus-command-method gnus-opened-servers)))
(setf (nth 1 elem) 'closed)))))
(defun gnus-request-list (gnus-command-method) (defun gnus-request-list (command-method)
"Request the active file from GNUS-COMMAND-METHOD." "Request the active file from COMMAND-METHOD."
(when (stringp gnus-command-method) (let ((gnus-command-method
(setq gnus-command-method (gnus-server-to-method gnus-command-method))) (if (stringp command-method)
(funcall (gnus-get-function gnus-command-method 'request-list) (gnus-server-to-method command-method)
(nth 1 gnus-command-method))) command-method)))
(funcall (gnus-get-function gnus-command-method 'request-list)
(nth 1 gnus-command-method))))
(defun gnus-server-get-active (server &optional ignored) (defun gnus-server-get-active (server &optional ignored)
"Return the active list for SERVER. "Return the active list for SERVER.
@ -407,47 +414,57 @@ Groups matching the IGNORED regexp are excluded."
(forward-line))))) (forward-line)))))
groups)) groups))
(defun gnus-finish-retrieve-group-infos (gnus-command-method infos data) (defun gnus-finish-retrieve-group-infos (command-method infos data)
"Read and update infos from GNUS-COMMAND-METHOD." "Read and update infos from COMMAND-METHOD."
(when (stringp gnus-command-method) (let ((gnus-command-method
(setq gnus-command-method (gnus-server-to-method gnus-command-method))) (if (stringp command-method)
(gnus-server-to-method command-method)
command-method)))
(gnus-backend-trace :finishing gnus-command-method) (gnus-backend-trace :finishing gnus-command-method)
(prog1 (prog1
(funcall (gnus-get-function gnus-command-method (funcall (gnus-get-function gnus-command-method
'finish-retrieve-group-infos) 'finish-retrieve-group-infos)
(nth 1 gnus-command-method) (nth 1 gnus-command-method)
infos data) infos data)
(gnus-backend-trace :finished gnus-command-method))) (gnus-backend-trace :finished gnus-command-method))))
(defun gnus-retrieve-group-data-early (gnus-command-method infos) (defun gnus-retrieve-group-data-early (command-method infos)
"Start early async retrieval of data from GNUS-COMMAND-METHOD." "Start early async retrieval of data from COMMAND-METHOD."
(when (stringp gnus-command-method) (let ((gnus-command-method
(setq gnus-command-method (gnus-server-to-method gnus-command-method))) (if (stringp command-method)
(funcall (gnus-get-function gnus-command-method 'retrieve-group-data-early) (gnus-server-to-method command-method)
(nth 1 gnus-command-method) command-method)))
infos)) (funcall (gnus-get-function gnus-command-method 'retrieve-group-data-early)
(nth 1 gnus-command-method)
infos)))
(defun gnus-request-list-newsgroups (gnus-command-method) (defun gnus-request-list-newsgroups (command-method)
"Request the newsgroups file from GNUS-COMMAND-METHOD." "Request the newsgroups file from COMMAND-METHOD."
(when (stringp gnus-command-method) (let ((gnus-command-method
(setq gnus-command-method (gnus-server-to-method gnus-command-method))) (if (stringp command-method)
(funcall (gnus-get-function gnus-command-method 'request-list-newsgroups) (gnus-server-to-method command-method)
(nth 1 gnus-command-method))) command-method)))
(funcall (gnus-get-function gnus-command-method 'request-list-newsgroups)
(nth 1 gnus-command-method))))
(defun gnus-request-newgroups (date gnus-command-method) (defun gnus-request-newgroups (date command-method)
"Request all new groups since DATE from GNUS-COMMAND-METHOD." "Request all new groups since DATE from COMMAND-METHOD."
(when (stringp gnus-command-method) (let ((gnus-command-method
(setq gnus-command-method (gnus-server-to-method gnus-command-method))) (if (stringp command-method)
(let ((func (gnus-get-function gnus-command-method 'request-newgroups t))) (gnus-server-to-method command-method)
(when func command-method)))
(funcall func date (nth 1 gnus-command-method))))) (let ((func (gnus-get-function gnus-command-method 'request-newgroups t)))
(when func
(funcall func date (nth 1 gnus-command-method))))))
(defun gnus-request-regenerate (gnus-command-method) (defun gnus-request-regenerate (command-method)
"Request a data generation from GNUS-COMMAND-METHOD." "Request a data generation from COMMAND-METHOD."
(when (stringp gnus-command-method) (let ((gnus-command-method
(setq gnus-command-method (gnus-server-to-method gnus-command-method))) (if (stringp command-method)
(funcall (gnus-get-function gnus-command-method 'request-regenerate) (gnus-server-to-method command-method)
(nth 1 gnus-command-method))) command-method)))
(funcall (gnus-get-function gnus-command-method 'request-regenerate)
(nth 1 gnus-command-method))))
(defun gnus-request-compact-group (group) (defun gnus-request-compact-group (group)
(let* ((method (gnus-find-method-for-group group)) (let* ((method (gnus-find-method-for-group group))
@ -459,17 +476,19 @@ Groups matching the IGNORED regexp are excluded."
(nth 1 gnus-command-method) t))) (nth 1 gnus-command-method) t)))
result)) result))
(defun gnus-request-compact (gnus-command-method) (defun gnus-request-compact (command-method)
"Request groups compaction from GNUS-COMMAND-METHOD." "Request groups compaction from COMMAND-METHOD."
(when (stringp gnus-command-method) (let ((gnus-command-method
(setq gnus-command-method (gnus-server-to-method gnus-command-method))) (if (stringp command-method)
(funcall (gnus-get-function gnus-command-method 'request-compact) (gnus-server-to-method command-method)
(nth 1 gnus-command-method))) command-method)))
(funcall (gnus-get-function gnus-command-method 'request-compact)
(nth 1 gnus-command-method))))
(defun gnus-request-group (group &optional dont-check gnus-command-method info) (defun gnus-request-group (group &optional dont-check command-method info)
"Request GROUP. If DONT-CHECK, no information is required." "Request GROUP. If DONT-CHECK, no information is required."
(let ((gnus-command-method (let ((gnus-command-method
(or gnus-command-method (inline (gnus-find-method-for-group group))))) (or command-method (inline (gnus-find-method-for-group group)))))
(when (stringp gnus-command-method) (when (stringp gnus-command-method)
(setq gnus-command-method (setq gnus-command-method
(inline (gnus-server-to-method gnus-command-method)))) (inline (gnus-server-to-method gnus-command-method))))
@ -522,12 +541,14 @@ If FETCH-OLD, retrieve all headers (or some subset thereof) in the group."
articles (gnus-group-real-name group) articles (gnus-group-real-name group)
(nth 1 gnus-command-method)))) (nth 1 gnus-command-method))))
(defun gnus-retrieve-groups (groups gnus-command-method) (defun gnus-retrieve-groups (groups command-method)
"Request active information on GROUPS from GNUS-COMMAND-METHOD." "Request active information on GROUPS from COMMAND-METHOD."
(when (stringp gnus-command-method) (let ((gnus-command-method
(setq gnus-command-method (gnus-server-to-method gnus-command-method))) (if (stringp command-method)
(funcall (gnus-get-function gnus-command-method 'retrieve-groups) (gnus-server-to-method command-method)
groups (nth 1 gnus-command-method))) command-method)))
(funcall (gnus-get-function gnus-command-method 'retrieve-groups)
groups (nth 1 gnus-command-method))))
(defun gnus-request-type (group &optional article) (defun gnus-request-type (group &optional article)
"Return the type (`post' or `mail') of GROUP (and ARTICLE)." "Return the type (`post' or `mail') of GROUP (and ARTICLE)."
@ -715,26 +736,33 @@ from other groups -- for instance, search results and the like."
(delete-region (point-min) (1- (point)))))) (delete-region (point-min) (1- (point))))))
res)) res))
(defun gnus-request-post (gnus-command-method) (defun gnus-request-post (command-method)
"Post the current buffer using GNUS-COMMAND-METHOD." "Post the current buffer using COMMAND-METHOD."
(when (stringp gnus-command-method)
(setq gnus-command-method (gnus-server-to-method gnus-command-method)))
(funcall (gnus-get-function gnus-command-method 'request-post)
(nth 1 gnus-command-method)))
(defun gnus-request-expunge-group (group gnus-command-method)
"Expunge GROUP, which is removing articles that have been marked as deleted."
(when (stringp gnus-command-method)
(setq gnus-command-method (gnus-server-to-method gnus-command-method)))
(funcall (gnus-get-function gnus-command-method 'request-expunge-group)
(gnus-group-real-name group)
(nth 1 gnus-command-method)))
(defun gnus-request-scan (group gnus-command-method)
"Request a SCAN being performed in GROUP from GNUS-COMMAND-METHOD.
If GROUP is nil, all groups on GNUS-COMMAND-METHOD are scanned."
(let ((gnus-command-method (let ((gnus-command-method
(if group (gnus-find-method-for-group group) gnus-command-method)) (if (stringp command-method)
(gnus-server-to-method command-method)
command-method)))
(funcall (gnus-get-function gnus-command-method 'request-post)
(nth 1 gnus-command-method))))
(defun gnus-request-expunge-group (group command-method)
"Expunge GROUP, which is removing articles that have been marked as deleted."
(let ((gnus-command-method
(if (stringp command-method)
(gnus-server-to-method command-method)
command-method)))
(funcall (gnus-get-function gnus-command-method 'request-expunge-group)
(gnus-group-real-name group)
(nth 1 gnus-command-method))))
(defvar mail-source-plugged)
(defvar gnus-inhibit-demon)
(defun gnus-request-scan (group command-method)
"Request a SCAN being performed in GROUP from COMMAND-METHOD.
If GROUP is nil, all groups on COMMAND-METHOD are scanned."
(let ((gnus-command-method
(if group (gnus-find-method-for-group group) command-method))
(gnus-inhibit-demon t) (gnus-inhibit-demon t)
(mail-source-plugged gnus-plugged)) (mail-source-plugged gnus-plugged))
(when (or gnus-plugged (when (or gnus-plugged
@ -744,36 +772,40 @@ If GROUP is nil, all groups on GNUS-COMMAND-METHOD are scanned."
(and group (gnus-group-real-name group)) (and group (gnus-group-real-name group))
(nth 1 gnus-command-method))))) (nth 1 gnus-command-method)))))
(defun gnus-request-update-info (info gnus-command-method) (defun gnus-request-update-info (info command-method)
(when (gnus-check-backend-function (when (gnus-check-backend-function
'request-update-info (car gnus-command-method)) 'request-update-info (car command-method))
(when (stringp gnus-command-method) (let ((gnus-command-method
(setq gnus-command-method (gnus-server-to-method gnus-command-method))) (if (stringp command-method)
(funcall (gnus-get-function gnus-command-method 'request-update-info) (gnus-server-to-method command-method)
(gnus-group-real-name (gnus-info-group info)) info command-method)))
(nth 1 gnus-command-method)))) (funcall (gnus-get-function gnus-command-method 'request-update-info)
(gnus-group-real-name (gnus-info-group info)) info
(nth 1 gnus-command-method)))))
(defsubst gnus-request-marks (info gnus-command-method) (defsubst gnus-request-marks (info command-method)
"Request that GNUS-COMMAND-METHOD update INFO." "Request that COMMAND-METHOD update INFO."
(when (stringp gnus-command-method) (let ((gnus-command-method
(setq gnus-command-method (gnus-server-to-method gnus-command-method))) (if (stringp command-method)
(when (gnus-check-backend-function (gnus-server-to-method command-method)
'request-marks (car gnus-command-method)) command-method)))
(let ((group (gnus-info-group info))) (when (gnus-check-backend-function
(and (funcall (gnus-get-function gnus-command-method 'request-marks) 'request-marks (car gnus-command-method))
(gnus-group-real-name group) (let ((group (gnus-info-group info)))
info (nth 1 gnus-command-method)) (and (funcall (gnus-get-function gnus-command-method 'request-marks)
;; If the minimum article number is greater than 1, then all (gnus-group-real-name group)
;; smaller article numbers are known not to exist; we'll info (nth 1 gnus-command-method))
;; artificially add those to the 'read range. ;; If the minimum article number is greater than 1, then all
(let* ((active (gnus-active group)) ;; smaller article numbers are known not to exist; we'll
(min (car active))) ;; artificially add those to the 'read range.
(when (> min 1) (let* ((active (gnus-active group))
(let* ((range (if (= min 2) 1 (cons 1 (1- min)))) (min (car active)))
(read (gnus-info-read info)) (when (> min 1)
(new-read (gnus-range-add read (list range)))) (let* ((range (if (= min 2) 1 (cons 1 (1- min))))
(setf (gnus-info-read info) new-read))) (read (gnus-info-read info))
info))))) (new-read (gnus-range-add read (list range))))
(setf (gnus-info-read info) new-read)))
info))))))
(defun gnus-request-expire-articles (articles group &optional force) (defun gnus-request-expire-articles (articles group &optional force)
(let* ((gnus-command-method (gnus-find-method-for-group group)) (let* ((gnus-command-method (gnus-find-method-for-group group))
@ -794,7 +826,7 @@ If GROUP is nil, all groups on GNUS-COMMAND-METHOD are scanned."
(gnus-agent-expire expired-articles group 'force)))) (gnus-agent-expire expired-articles group 'force))))
not-deleted)) not-deleted))
(defun gnus-request-move-article (article group server accept-function (defun gnus-request-move-article (article group _server accept-function
&optional last move-is-internal) &optional last move-is-internal)
(let* ((gnus-command-method (gnus-find-method-for-group group)) (let* ((gnus-command-method (gnus-find-method-for-group group))
(result (funcall (gnus-get-function gnus-command-method (result (funcall (gnus-get-function gnus-command-method
@ -807,38 +839,40 @@ If GROUP is nil, all groups on GNUS-COMMAND-METHOD are scanned."
(gnus-agent-unfetch-articles group (list article))) (gnus-agent-unfetch-articles group (list article)))
result)) result))
(defun gnus-request-accept-article (group &optional gnus-command-method last (defun gnus-request-accept-article (group &optional command-method last
no-encode) no-encode)
(when (stringp gnus-command-method) (let ((gnus-command-method
(setq gnus-command-method (gnus-server-to-method gnus-command-method))) (if (stringp command-method)
(when (and (not gnus-command-method) (gnus-server-to-method command-method)
(stringp group)) command-method)))
(setq gnus-command-method (or (gnus-find-method-for-group group) (when (and (not gnus-command-method)
(gnus-group-name-to-method group)))) (stringp group))
(goto-char (point-max)) (setq gnus-command-method (or (gnus-find-method-for-group group)
;; Make sure there's a newline at the end of the article. (gnus-group-name-to-method group))))
(unless (bolp) (goto-char (point-max))
(insert "\n")) ;; Make sure there's a newline at the end of the article.
(unless no-encode (unless (bolp)
(let ((message-options message-options)) (insert "\n"))
(message-options-set-recipient) (unless no-encode
(save-restriction (let ((message-options message-options))
(message-narrow-to-head) (message-options-set-recipient)
(mail-encode-encoded-word-buffer)) (save-restriction
(message-encode-message-body))) (message-narrow-to-head)
(let ((gnus-command-method (or gnus-command-method (mail-encode-encoded-word-buffer))
(gnus-find-method-for-group group))) (message-encode-message-body)))
(result (let ((gnus-command-method (or gnus-command-method
(funcall (gnus-find-method-for-group group)))
(gnus-get-function gnus-command-method 'request-accept-article) (result
(if (stringp group) (gnus-group-real-name group) group) (funcall
(cadr gnus-command-method) (gnus-get-function gnus-command-method 'request-accept-article)
last))) (if (stringp group) (gnus-group-real-name group) group)
(when (and gnus-agent (cadr gnus-command-method)
(gnus-agent-method-p gnus-command-method) last)))
(cdr result)) (when (and gnus-agent
(gnus-agent-regenerate-group group (list (cdr result)))) (gnus-agent-method-p gnus-command-method)
result)) (cdr result))
(gnus-agent-regenerate-group group (list (cdr result))))
result)))
(defun gnus-request-replace-article (article group buffer &optional no-encode) (defun gnus-request-replace-article (article group buffer &optional no-encode)
(unless no-encode (unless no-encode
@ -862,13 +896,14 @@ If GROUP is nil, all groups on GNUS-COMMAND-METHOD are scanned."
article (gnus-group-real-name group) article (gnus-group-real-name group)
(nth 1 gnus-command-method)))) (nth 1 gnus-command-method))))
(defun gnus-request-create-group (group &optional gnus-command-method args) (defun gnus-request-create-group (group &optional command-method args)
(when (stringp gnus-command-method) (let* ((gnus-command-method
(setq gnus-command-method (gnus-server-to-method gnus-command-method))) (or (if (stringp command-method)
(let ((gnus-command-method (gnus-server-to-method command-method)
(or gnus-command-method (gnus-find-method-for-group group)))) command-method)
(gnus-find-method-for-group group))))
(funcall (gnus-get-function gnus-command-method 'request-create-group) (funcall (gnus-get-function gnus-command-method 'request-create-group)
(gnus-group-real-name group) (nth 1 gnus-command-method) args))) (gnus-group-real-name group) (nth 1 gnus-command-method) args)))
(defun gnus-request-delete-group (group &optional force) (defun gnus-request-delete-group (group &optional force)
(let* ((gnus-command-method (gnus-find-method-for-group group)) (let* ((gnus-command-method (gnus-find-method-for-group group))
@ -902,15 +937,18 @@ If GROUP is nil, all groups on GNUS-COMMAND-METHOD are scanned."
"-request-close")))) "-request-close"))))
(funcall func))))) (funcall func)))))
(defun gnus-asynchronous-p (gnus-command-method) (defun gnus-asynchronous-p (command-method)
(let ((func (gnus-get-function gnus-command-method 'asynchronous-p t))) (let ((func (gnus-get-function command-method 'asynchronous-p t)))
(when (fboundp func) (when (fboundp func)
(funcall func)))) (let ((gnus-command-method command-method))
(funcall func)))))
(defun gnus-remove-denial (gnus-command-method) (defun gnus-remove-denial (command-method)
(when (stringp gnus-command-method) (let* ((gnus-command-method
(setq gnus-command-method (gnus-server-to-method gnus-command-method))) (if (stringp command-method)
(let* ((elem (assoc gnus-command-method gnus-opened-servers)) (gnus-server-to-method command-method)
command-method))
(elem (assoc gnus-command-method gnus-opened-servers))
(status (cadr elem))) (status (cadr elem)))
;; If this hasn't been opened before, we add it to the list. ;; If this hasn't been opened before, we add it to the list.
(when (eq status 'denied) (when (eq status 'denied)

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

@ -1,4 +1,4 @@
;;; gnus-kill.el --- kill commands for Gnus ;;; gnus-kill.el --- kill commands for Gnus -*- lexical-binding: t; -*-
;; Copyright (C) 1995-2021 Free Software Foundation, Inc. ;; Copyright (C) 1995-2021 Free Software Foundation, Inc.
@ -275,7 +275,7 @@ If NEWSGROUP is nil, the global kill file is selected."
(save-excursion (save-excursion
(save-window-excursion (save-window-excursion
(pop-to-buffer gnus-summary-buffer) (pop-to-buffer gnus-summary-buffer)
(eval (car (read-from-string string))))))) (eval (car (read-from-string string)) t)))))
(defun gnus-kill-file-apply-last-sexp () (defun gnus-kill-file-apply-last-sexp ()
"Apply sexp before point in current buffer to current newsgroup." "Apply sexp before point in current buffer to current newsgroup."
@ -289,7 +289,7 @@ If NEWSGROUP is nil, the global kill file is selected."
(save-excursion (save-excursion
(save-window-excursion (save-window-excursion
(pop-to-buffer gnus-summary-buffer) (pop-to-buffer gnus-summary-buffer)
(eval (car (read-from-string string)))))) (eval (car (read-from-string string)) t))))
(ding) (gnus-message 2 "No newsgroup is selected."))) (ding) (gnus-message 2 "No newsgroup is selected.")))
(defun gnus-kill-file-exit () (defun gnus-kill-file-exit ()
@ -403,9 +403,9 @@ Returns the number of articles marked as read."
(eq (car form) 'gnus-lower)) (eq (car form) 'gnus-lower))
(progn (progn
(delete-region beg (point)) (delete-region beg (point))
(insert (or (eval form) ""))) (insert (or (eval form t) "")))
(with-current-buffer gnus-summary-buffer (with-current-buffer gnus-summary-buffer
(ignore-errors (eval form))))) (ignore-errors (eval form t)))))
(and (buffer-modified-p) (and (buffer-modified-p)
gnus-kill-save-kill-file gnus-kill-save-kill-file
(save-buffer)) (save-buffer))
@ -560,7 +560,7 @@ COMMAND must be a Lisp expression or a string representing a key sequence."
((functionp form) ((functionp form)
(funcall form)) (funcall form))
(t (t
(eval form))))) (eval form t)))))
;; Search article body. ;; Search article body.
(let ((gnus-current-article nil) ;Save article pointer. (let ((gnus-current-article nil) ;Save article pointer.
(gnus-last-article nil) (gnus-last-article nil)
@ -578,7 +578,7 @@ COMMAND must be a Lisp expression or a string representing a key sequence."
((functionp form) ((functionp form)
(funcall form)) (funcall form))
(t (t
(eval form))))))) (eval form t)))))))
did-kill))) did-kill)))
(defun gnus-execute (field regexp form &optional backward unread) (defun gnus-execute (field regexp form &optional backward unread)

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

@ -1,4 +1,4 @@
;;; gnus-logic.el --- advanced scoring code for Gnus ;;; gnus-logic.el --- advanced scoring code for Gnus -*- lexical-binding: t; -*-
;; Copyright (C) 1996-2021 Free Software Foundation, Inc. ;; Copyright (C) 1996-2021 Free Software Foundation, Inc.

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

@ -1,4 +1,4 @@
;;; gnus-mh.el --- mh-e interface for Gnus ;;; gnus-mh.el --- mh-e interface for Gnus -*- lexical-binding: t; -*-
;; Copyright (C) 1994-2021 Free Software Foundation, Inc. ;; Copyright (C) 1994-2021 Free Software Foundation, Inc.
@ -95,7 +95,7 @@ Optional argument FOLDER specifies folder name."
(kill-buffer errbuf)))) (kill-buffer errbuf))))
(setq gnus-newsgroup-last-folder folder))) (setq gnus-newsgroup-last-folder folder)))
(defun gnus-Folder-save-name (newsgroup headers &optional last-folder) (defun gnus-Folder-save-name (newsgroup _headers &optional last-folder)
"Generate folder name from NEWSGROUP, HEADERS, and optional LAST-FOLDER. "Generate folder name from NEWSGROUP, HEADERS, and optional LAST-FOLDER.
If variable `gnus-use-long-file-name' is nil, it is +News.group. If variable `gnus-use-long-file-name' is nil, it is +News.group.
Otherwise, it is like +news/group." Otherwise, it is like +news/group."
@ -105,7 +105,7 @@ Otherwise, it is like +news/group."
(gnus-capitalize-newsgroup newsgroup) (gnus-capitalize-newsgroup newsgroup)
(gnus-newsgroup-directory-form newsgroup))))) (gnus-newsgroup-directory-form newsgroup)))))
(defun gnus-folder-save-name (newsgroup headers &optional last-folder) (defun gnus-folder-save-name (newsgroup _headers &optional last-folder)
"Generate folder name from NEWSGROUP, HEADERS, and optional LAST-FOLDER. "Generate folder name from NEWSGROUP, HEADERS, and optional LAST-FOLDER.
If variable `gnus-use-long-file-name' is nil, it is +news.group. If variable `gnus-use-long-file-name' is nil, it is +news.group.
Otherwise, it is like +news/group." Otherwise, it is like +news/group."

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

@ -1,4 +1,4 @@
;;; gnus-ml.el --- Mailing list minor mode for Gnus ;;; gnus-ml.el --- Mailing list minor mode for Gnus -*- lexical-binding: t; -*-
;; Copyright (C) 2000-2021 Free Software Foundation, Inc. ;; Copyright (C) 2000-2021 Free Software Foundation, Inc.

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

@ -1,4 +1,4 @@
;;; gnus-mlspl.el --- a group params-based mail splitting mechanism ;;; gnus-mlspl.el --- a group params-based mail splitting mechanism -*- lexical-binding: t; -*-
;; Copyright (C) 1998-2021 Free Software Foundation, Inc. ;; Copyright (C) 1998-2021 Free Software Foundation, Inc.

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

@ -1,4 +1,4 @@
;;; gnus-msg.el --- mail and post interface for Gnus ;;; gnus-msg.el --- mail and post interface for Gnus -*- lexical-binding: t; -*-
;; Copyright (C) 1995-2021 Free Software Foundation, Inc. ;; Copyright (C) 1995-2021 Free Software Foundation, Inc.
@ -517,7 +517,7 @@ instead."
switch-action yank-action send-actions return-action)) switch-action yank-action send-actions return-action))
(let ((buf (current-buffer)) (let ((buf (current-buffer))
;; Don't use posting styles corresponding to any existing group. ;; Don't use posting styles corresponding to any existing group.
(group-name gnus-newsgroup-name) ;; (group-name gnus-newsgroup-name)
mail-buf) mail-buf)
(let ((gnus-newsgroup-name "")) (let ((gnus-newsgroup-name ""))
(gnus-setup-message (gnus-setup-message
@ -610,10 +610,10 @@ If ARG is 1, prompt for a group name to find the posting style."
(interactive "P") (interactive "P")
;; We can't `let' gnus-newsgroup-name here, since that leads ;; We can't `let' gnus-newsgroup-name here, since that leads
;; to local variables leaking. ;; to local variables leaking.
(let* ((group gnus-newsgroup-name) (let* (;;(group gnus-newsgroup-name)
;; make sure last viewed article doesn't affect posting styles: ;; make sure last viewed article doesn't affect posting styles:
(gnus-article-copy) (gnus-article-copy)
(buffer (current-buffer)) ;; (buffer (current-buffer))
(gnus-newsgroup-name (gnus-newsgroup-name
(if arg (if arg
(if (= 1 (prefix-numeric-value arg)) (if (= 1 (prefix-numeric-value arg))
@ -635,10 +635,10 @@ network. The corresponding back end must have a `request-post' method."
(interactive "P") (interactive "P")
;; We can't `let' gnus-newsgroup-name here, since that leads ;; We can't `let' gnus-newsgroup-name here, since that leads
;; to local variables leaking. ;; to local variables leaking.
(let* ((group gnus-newsgroup-name) (let* (;;(group gnus-newsgroup-name)
;; make sure last viewed article doesn't affect posting styles: ;; make sure last viewed article doesn't affect posting styles:
(gnus-article-copy) (gnus-article-copy)
(buffer (current-buffer)) ;; (buffer (current-buffer))
(gnus-newsgroup-name (gnus-newsgroup-name
(if arg (if arg
(if (= 1 (prefix-numeric-value arg)) (if (= 1 (prefix-numeric-value arg))
@ -678,10 +678,10 @@ posting style."
(interactive "P") (interactive "P")
;; We can't `let' gnus-newsgroup-name here, since that leads ;; We can't `let' gnus-newsgroup-name here, since that leads
;; to local variables leaking. ;; to local variables leaking.
(let* ((group gnus-newsgroup-name) (let* (;;(group gnus-newsgroup-name)
;; make sure last viewed article doesn't affect posting styles: ;; make sure last viewed article doesn't affect posting styles:
(gnus-article-copy) (gnus-article-copy)
(buffer (current-buffer)) ;; (buffer (current-buffer))
(gnus-newsgroup-name (gnus-newsgroup-name
(if arg (if arg
(if (= 1 (prefix-numeric-value arg)) (if (= 1 (prefix-numeric-value arg))
@ -703,10 +703,10 @@ network. The corresponding back end must have a `request-post' method."
(interactive "P") (interactive "P")
;; We can't `let' gnus-newsgroup-name here, since that leads ;; We can't `let' gnus-newsgroup-name here, since that leads
;; to local variables leaking. ;; to local variables leaking.
(let* ((group gnus-newsgroup-name) (let* (;;(group gnus-newsgroup-name)
;; make sure last viewed article doesn't affect posting styles: ;; make sure last viewed article doesn't affect posting styles:
(gnus-article-copy) (gnus-article-copy)
(buffer (current-buffer)) ;; (buffer (current-buffer))
(gnus-newsgroup-name (gnus-newsgroup-name
(if arg (if arg
(if (= 1 (prefix-numeric-value arg)) (if (= 1 (prefix-numeric-value arg))
@ -930,7 +930,7 @@ header line with the old Message-ID."
(run-hooks 'gnus-article-decode-hook))))) (run-hooks 'gnus-article-decode-hook)))))
gnus-article-copy))) gnus-article-copy)))
(defun gnus-post-news (post &optional group header article-buffer yank subject (defun gnus-post-news (post &optional group header article-buffer yank _subject
force-news) force-news)
(when article-buffer (when article-buffer
(gnus-copy-article-buffer)) (gnus-copy-article-buffer))
@ -1732,7 +1732,7 @@ this is a reply."
;; Function. ;; Function.
(funcall (car var) group)) (funcall (car var) group))
(t (t
(eval (car var))))))) (eval (car var) t))))))
(setq var (cdr var))) (setq var (cdr var)))
result))) result)))
name) name)
@ -1789,7 +1789,7 @@ this is a reply."
(with-current-buffer gnus-summary-buffer (with-current-buffer gnus-summary-buffer
gnus-posting-styles) gnus-posting-styles)
gnus-posting-styles)) gnus-posting-styles))
style match attribute value v results matched-string match value v results matched-string ;; style attribute
filep name address element) filep name address element)
;; If the group has a posting-style parameter, add it at the end with a ;; If the group has a posting-style parameter, add it at the end with a
;; regexp matching everything, to be sure it takes precedence over all ;; regexp matching everything, to be sure it takes precedence over all
@ -1844,7 +1844,7 @@ this is a reply."
(setq matched-string header))))))) (setq matched-string header)))))))
(t (t
;; This is a form to be evalled. ;; This is a form to be evalled.
(eval match))))) (eval match t)))))
;; We have a match, so we set the variables. ;; We have a match, so we set the variables.
(dolist (attribute style) (dolist (attribute style)
(setq element (pop attribute) (setq element (pop attribute)
@ -1875,7 +1875,7 @@ this is a reply."
((boundp value) ((boundp value)
(symbol-value value)))) (symbol-value value))))
((listp value) ((listp value)
(eval value)))) (eval value t))))
;; Translate obsolescent value. ;; Translate obsolescent value.
(cond (cond
((eq element 'signature-file) ((eq element 'signature-file)

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

@ -1,4 +1,4 @@
;; gnus-notifications.el -- Send notification on new message in Gnus ;; gnus-notifications.el -- Send notification on new message in Gnus -*- lexical-binding: t; -*-
;; Copyright (C) 2012-2021 Free Software Foundation, Inc. ;; Copyright (C) 2012-2021 Free Software Foundation, Inc.

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

@ -1,4 +1,4 @@
;;; gnus-picon.el --- displaying pretty icons in Gnus ;;; gnus-picon.el --- displaying pretty icons in Gnus -*- lexical-binding: t; -*-
;; Copyright (C) 1996-2021 Free Software Foundation, Inc. ;; Copyright (C) 1996-2021 Free Software Foundation, Inc.
@ -112,7 +112,7 @@ List of pairs (KEY . GLYPH) where KEY is either a filename or an URL.")
(let* ((address (gnus-picon-split-address address)) (let* ((address (gnus-picon-split-address address))
(user (pop address)) (user (pop address))
(faddress address) (faddress address)
database directory result instance base) result base) ;; database directory instance
(catch 'found (catch 'found
(dolist (database gnus-picon-databases) (dolist (database gnus-picon-databases)
(dolist (directory directories) (dolist (directory directories)
@ -249,7 +249,7 @@ replacement is added."
(gnus-article-goto-header header) (gnus-article-goto-header header)
(mail-header-narrow-to-field) (mail-header-narrow-to-field)
(let ((groups (message-tokenize-header (mail-fetch-field header))) (let ((groups (message-tokenize-header (mail-fetch-field header)))
spec file point) spec file) ;; point
(dolist (group groups) (dolist (group groups)
(unless (setq spec (cdr (assoc group gnus-picon-cache))) (unless (setq spec (cdr (assoc group gnus-picon-cache)))
(setq spec (nreverse (split-string group "[.]"))) (setq spec (nreverse (split-string group "[.]")))

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

@ -1,4 +1,4 @@
;;; gnus-range.el --- range and sequence functions for Gnus ;;; gnus-range.el --- range and sequence functions for Gnus -*- lexical-binding: t; -*-
;; Copyright (C) 1996-2021 Free Software Foundation, Inc. ;; Copyright (C) 1996-2021 Free Software Foundation, Inc.
@ -87,7 +87,7 @@ Both ranges must be in ascending order."
(setq range2 (gnus-range-normalize range2)) (setq range2 (gnus-range-normalize range2))
(let* ((new-range (cons nil (copy-sequence range1))) (let* ((new-range (cons nil (copy-sequence range1)))
(r new-range) (r new-range)
(safe t)) ) ;; (safe t)
(while (cdr r) (while (cdr r)
(let* ((r1 (cadr r)) (let* ((r1 (cadr r))
(r2 (car range2)) (r2 (car range2))

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

@ -1,4 +1,4 @@
;;; gnus-rfc1843.el --- HZ (rfc1843) decoding interface functions for Gnus ;;; gnus-rfc1843.el --- HZ (rfc1843) decoding interface functions for Gnus -*- lexical-binding: t; -*-
;; Copyright (C) 1998-2021 Free Software Foundation, Inc. ;; Copyright (C) 1998-2021 Free Software Foundation, Inc.

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

@ -1,4 +1,4 @@
;;; gnus-salt.el --- alternate summary mode interfaces for Gnus ;;; gnus-salt.el --- alternate summary mode interfaces for Gnus -*- lexical-binding: t; -*-
;; Copyright (C) 1996-1999, 2001-2021 Free Software Foundation, Inc. ;; Copyright (C) 1996-1999, 2001-2021 Free Software Foundation, Inc.
@ -609,7 +609,7 @@ Two predefined functions are available:
beg end) beg end)
(add-text-properties (add-text-properties
(setq beg (point)) (setq beg (point))
(setq end (progn (eval gnus-tree-line-format-spec) (point))) (setq end (progn (eval gnus-tree-line-format-spec t) (point)))
(list 'gnus-number gnus-tmp-number)) (list 'gnus-number gnus-tmp-number))
(when (or t (gnus-visual-p 'tree-highlight 'highlight)) (when (or t (gnus-visual-p 'tree-highlight 'highlight))
(gnus-tree-highlight-node gnus-tmp-number beg end)))) (gnus-tree-highlight-node gnus-tmp-number beg end))))

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

@ -1,4 +1,4 @@
;;; gnus-score.el --- scoring code for Gnus ;;; gnus-score.el --- scoring code for Gnus -*- lexical-binding: t; -*-
;; Copyright (C) 1995-2021 Free Software Foundation, Inc. ;; Copyright (C) 1995-2021 Free Software Foundation, Inc.
@ -1235,7 +1235,7 @@ If FORMAT, also format the current score file."
(let ((mark (car (gnus-score-get 'mark alist))) (let ((mark (car (gnus-score-get 'mark alist)))
(expunge (car (gnus-score-get 'expunge alist))) (expunge (car (gnus-score-get 'expunge alist)))
(mark-and-expunge (car (gnus-score-get 'mark-and-expunge alist))) (mark-and-expunge (car (gnus-score-get 'mark-and-expunge alist)))
(score-fn (car (gnus-score-get 'score-fn alist))) ;; (score-fn (car (gnus-score-get 'score-fn alist)))
(files (gnus-score-get 'files alist)) (files (gnus-score-get 'files alist))
(exclude-files (gnus-score-get 'exclude-files alist)) (exclude-files (gnus-score-get 'exclude-files alist))
(orphan (car (gnus-score-get 'orphan alist))) (orphan (car (gnus-score-get 'orphan alist)))
@ -1263,7 +1263,7 @@ If FORMAT, also format the current score file."
(if adapt-file (cons adapt-file files) (if adapt-file (cons adapt-file files)
files))))) files)))))
(when (and eval (not global)) (when (and eval (not global))
(eval eval)) (eval eval t))
;; We then expand any exclude-file directives. ;; We then expand any exclude-file directives.
(setq gnus-scores-exclude-files (setq gnus-scores-exclude-files
(nconc (nconc
@ -2698,7 +2698,7 @@ the score file and its full name, including the directory.")
;;; Finding score files. ;;; Finding score files.
(defun gnus-score-score-files (group) (defun gnus-score-score-files (_group)
"Return a list of all possible score files." "Return a list of all possible score files."
;; Search and set any global score files. ;; Search and set any global score files.
(when gnus-global-score-files (when gnus-global-score-files

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

@ -1,4 +1,4 @@
;;; gnus-sieve.el --- Utilities to manage sieve scripts for Gnus ;;; gnus-sieve.el --- Utilities to manage sieve scripts for Gnus -*- lexical-binding: t; -*-
;; Copyright (C) 2001-2021 Free Software Foundation, Inc. ;; Copyright (C) 2001-2021 Free Software Foundation, Inc.

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

@ -1,4 +1,4 @@
;;; gnus-spec.el --- format spec functions for Gnus ;;; gnus-spec.el --- format spec functions for Gnus -*- lexical-binding: t; -*-
;; Copyright (C) 1996-2021 Free Software Foundation, Inc. ;; Copyright (C) 1996-2021 Free Software Foundation, Inc.
@ -628,8 +628,8 @@ or to characters when given a pad value."
If PROPS, insert the result." If PROPS, insert the result."
(let ((form (gnus-parse-format format alist props))) (let ((form (gnus-parse-format format alist props)))
(if props (if props
(add-text-properties (point) (progn (eval form) (point)) props) (add-text-properties (point) (progn (eval form t) (point)) props)
(eval form)))) (eval form t))))
(defun gnus-set-format (type &optional insertable) (defun gnus-set-format (type &optional insertable)
(set (intern (format "gnus-%s-line-format-spec" type)) (set (intern (format "gnus-%s-line-format-spec" type))

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

@ -1,4 +1,4 @@
;;; gnus-srvr.el --- virtual server support for Gnus ;;; gnus-srvr.el --- virtual server support for Gnus -*- lexical-binding: t; -*-
;; Copyright (C) 1995-2021 Free Software Foundation, Inc. ;; Copyright (C) 1995-2021 Free Software Foundation, Inc.
@ -297,7 +297,7 @@ The following commands are available:
(point) (point)
(prog1 (1+ (point)) (prog1 (1+ (point))
;; Insert the text. ;; Insert the text.
(eval gnus-server-line-format-spec)) (eval gnus-server-line-format-spec t))
(list 'gnus-server (intern gnus-tmp-name) (list 'gnus-server (intern gnus-tmp-name)
'gnus-named-server (intern (gnus-method-to-server method t)))))) 'gnus-named-server (intern (gnus-method-to-server method t))))))
@ -626,7 +626,7 @@ The following commands are available:
(let ((info (gnus-server-to-method server))) (let ((info (gnus-server-to-method server)))
(gnus-edit-form (gnus-edit-form
info "Showing the server." info "Showing the server."
(lambda (form) (lambda (_form)
(gnus-server-position-point)) (gnus-server-position-point))
'edit-server))) 'edit-server)))

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

@ -3186,7 +3186,7 @@ The following commands are available:
;; Copy the global value of the variable. ;; Copy the global value of the variable.
(symbol-value (car local)) (symbol-value (car local))
;; Use the value from the list. ;; Use the value from the list.
(eval (cdr local))))) (eval (cdr local) t))))
(set (make-local-variable (car local)) global)) (set (make-local-variable (car local)) global))
;; Simple nil-valued local variable. ;; Simple nil-valued local variable.
(set (make-local-variable local) nil)))) (set (make-local-variable local) nil))))
@ -3850,7 +3850,7 @@ buffer that was in action when the last article was fetched."
(condition-case () (condition-case ()
(put-text-property (put-text-property
(point) (point)
(progn (eval gnus-summary-line-format-spec) (point)) (progn (eval gnus-summary-line-format-spec t) (point))
'gnus-number gnus-tmp-number) 'gnus-number gnus-tmp-number)
(error (gnus-message 5 "Error updating the summary line"))) (error (gnus-message 5 "Error updating the summary line")))
(when (gnus-visual-p 'summary-highlight 'highlight) (when (gnus-visual-p 'summary-highlight 'highlight)
@ -3971,14 +3971,14 @@ Input should look like this: \"Sun, 14 Oct 2001 13:34:39 +0200\"."
(my-format "%b %d '%y")) (my-format "%b %d '%y"))
(let* ((difference (time-subtract now messy-date)) (let* ((difference (time-subtract now messy-date))
(templist gnus-user-date-format-alist) (templist gnus-user-date-format-alist)
(top (eval (caar templist)))) (top (eval (caar templist) t)))
(while (if (numberp top) (time-less-p top difference) (not top)) (while (if (numberp top) (time-less-p top difference) (not top))
(progn (progn
(setq templist (cdr templist)) (setq templist (cdr templist))
(setq top (eval (caar templist))))) (setq top (eval (caar templist) t))))
(if (stringp (cdr (car templist))) (if (stringp (cdr (car templist)))
(setq my-format (cdr (car templist))))) (setq my-format (cdr (car templist)))))
(format-time-string (eval my-format) messy-date)) (format-time-string (eval my-format t) messy-date))
(error " ? "))) (error " ? ")))
(defun gnus-summary-set-local-parameters (group) (defun gnus-summary-set-local-parameters (group)
@ -3997,8 +3997,8 @@ Input should look like this: \"Sun, 14 Oct 2001 13:34:39 +0200\"."
;; buffer-local, whereas just parameters like `gcc-self', ;; buffer-local, whereas just parameters like `gcc-self',
;; `timestamp', etc. should not be bound as variables. ;; `timestamp', etc. should not be bound as variables.
(if (boundp (car elem)) (if (boundp (car elem))
(set (make-local-variable (car elem)) (eval (nth 1 elem))) (set (make-local-variable (car elem)) (eval (nth 1 elem) t))
(eval (nth 1 elem)))))))) (eval (nth 1 elem) t)))))))
(defun gnus-summary-read-group (group &optional show-all no-article (defun gnus-summary-read-group (group &optional show-all no-article
kill-buffer no-display backward kill-buffer no-display backward
@ -5557,7 +5557,7 @@ or a straight list of headers."
(setq gnus-tmp-thread thread) (setq gnus-tmp-thread thread)
(put-text-property (put-text-property
(point) (point)
(progn (eval gnus-summary-line-format-spec) (point)) (progn (eval gnus-summary-line-format-spec t) (point))
'gnus-number number) 'gnus-number number)
(when gnus-visual-p (when gnus-visual-p
(forward-line -1) (forward-line -1)
@ -6265,7 +6265,7 @@ If WHERE is `summary', the summary mode line format will be used."
"")) ""))
bufname-length max-len bufname-length max-len
gnus-tmp-header) ;; passed as argument to any user-format-funcs gnus-tmp-header) ;; passed as argument to any user-format-funcs
(setq mode-string (eval mformat)) (setq mode-string (eval mformat t))
(setq bufname-length (if (string-match "%b" mode-string) (setq bufname-length (if (string-match "%b" mode-string)
(- (length (- (length
(buffer-name (buffer-name
@ -7863,7 +7863,7 @@ If BACKWARD, the previous article is selected instead of the next."
(switch-to-buffer gnus-group-buffer) (switch-to-buffer gnus-group-buffer)
(when group (when group
(gnus-group-jump-to-group group)) (gnus-group-jump-to-group group))
(eval (cadr (assq key keystrokes))) (eval (cadr (assq key keystrokes)) t)
(setq group (gnus-group-group-name)) (setq group (gnus-group-group-name))
(switch-to-buffer obuf)) (switch-to-buffer obuf))
(setq ended nil)) (setq ended nil))
@ -10617,6 +10617,8 @@ confirmation before the articles are deleted."
(gnus-set-mode-line 'summary) (gnus-set-mode-line 'summary)
not-deleted)) not-deleted))
(defvar message-options-set-recipient)
(defun gnus-summary-edit-article (&optional arg) (defun gnus-summary-edit-article (&optional arg)
"Edit the current article. "Edit the current article.
This will have permanent effect only in mail groups. This will have permanent effect only in mail groups.
@ -12366,7 +12368,7 @@ save those articles instead."
;; Form. ;; Form.
(save-restriction (save-restriction
(widen) (widen)
(setq result (eval match))))) (setq result (eval match t)))))
(setq split-name (cdr method)) (setq split-name (cdr method))
(cond ((stringp result) (cond ((stringp result)
(push (expand-file-name (push (expand-file-name
@ -12956,7 +12958,7 @@ treated as multipart/mixed."
(nomove "" nil nil ,keystroke))) (nomove "" nil nil ,keystroke)))
(let ((func (gnus-summary-make-marking-command-1 (let ((func (gnus-summary-make-marking-command-1
mark (car lway) lway name))) mark (car lway) lway name)))
(setq func (eval func)) (setq func (eval func t))
(define-key map (nth 4 lway) func))))) (define-key map (nth 4 lway) func)))))
(defun gnus-summary-make-marking-command-1 (mark way lway name) (defun gnus-summary-make-marking-command-1 (mark way lway name)

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

@ -1,4 +1,4 @@
;;; gnus-topic.el --- a folding minor mode for Gnus group buffers ;;; gnus-topic.el --- a folding minor mode for Gnus group buffers -*- lexical-binding: t; -*-
;; Copyright (C) 1995-2021 Free Software Foundation, Inc. ;; Copyright (C) 1995-2021 Free Software Foundation, Inc.
@ -640,7 +640,14 @@ articles in the topic and its subtopics."
(add-text-properties (add-text-properties
(point) (point)
(prog1 (1+ (point)) (prog1 (1+ (point))
(eval gnus-topic-line-format-spec)) (eval gnus-topic-line-format-spec
`((indentation . ,indentation)
(visible . ,visible)
(name . ,name)
(level . ,level)
(number-of-groups . ,number-of-groups)
(total-number-of-articles . ,total-number-of-articles)
(entries . ,entries))))
(list 'gnus-topic name (list 'gnus-topic name
'gnus-topic-level level 'gnus-topic-level level
'gnus-topic-unread unread 'gnus-topic-unread unread

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

@ -1,4 +1,4 @@
;;; gnus-undo.el --- minor mode for undoing in Gnus ;;; gnus-undo.el --- minor mode for undoing in Gnus -*- lexical-binding: t; -*-
;; Copyright (C) 1996-2021 Free Software Foundation, Inc. ;; Copyright (C) 1996-2021 Free Software Foundation, Inc.
@ -153,10 +153,10 @@
;; We are not at a boundary... ;; We are not at a boundary...
(setq gnus-undo-boundary-inhibit t))) (setq gnus-undo-boundary-inhibit t)))
(defun gnus-undo (n) (defun gnus-undo (_n)
"Undo some previous changes in Gnus buffers. "Undo some previous changes in Gnus buffers.
Repeat this command to undo more changes. Repeat this command to undo more changes."
A numeric argument serves as a repeat count." ;; FIXME: A numeric argument should serve as a repeat count.
(interactive "p") (interactive "p")
(unless gnus-undo-mode (unless gnus-undo-mode
(error "Undoing is not enabled in this buffer")) (error "Undoing is not enabled in this buffer"))

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

@ -1,4 +1,4 @@
;;; gnus-util.el --- utility functions for Gnus ;;; gnus-util.el --- utility functions for Gnus -*- lexical-binding: t; -*-
;; Copyright (C) 1996-2021 Free Software Foundation, Inc. ;; Copyright (C) 1996-2021 Free Software Foundation, Inc.
@ -681,6 +681,8 @@ yield \"nnimap:yxa\"."
(define-key (symbol-value (intern (format "gnus-%s-mode-map" type))) (define-key (symbol-value (intern (format "gnus-%s-mode-map" type)))
[menu-bar edit] 'undefined)) [menu-bar edit] 'undefined))
(defvar print-string-length)
(defmacro gnus-bind-print-variables (&rest forms) (defmacro gnus-bind-print-variables (&rest forms)
"Bind print-* variables and evaluate FORMS. "Bind print-* variables and evaluate FORMS.
This macro is used with `prin1', `pp', etc. in order to ensure This macro is used with `prin1', `pp', etc. in order to ensure
@ -1241,7 +1243,7 @@ sure of changing the value of `foo'."
(setq gnus-info-buffer (current-buffer)) (setq gnus-info-buffer (current-buffer))
(gnus-configure-windows 'info))) (gnus-configure-windows 'info)))
(defun gnus-not-ignore (&rest args) (defun gnus-not-ignore (&rest _args)
t) t)
(defvar gnus-directory-sep-char-regexp "/" (defvar gnus-directory-sep-char-regexp "/"
@ -1381,6 +1383,7 @@ SPEC is a predicate specifier that contains stuff like `or', `and',
(declare-function iswitchb-minibuffer-setup "iswitchb") (declare-function iswitchb-minibuffer-setup "iswitchb")
(defvar iswitchb-temp-buflist) (defvar iswitchb-temp-buflist)
(defvar iswitchb-mode) (defvar iswitchb-mode)
(defvar iswitchb-make-buflist-hook)
(defun gnus-iswitchb-completing-read (prompt collection &optional require-match (defun gnus-iswitchb-completing-read (prompt collection &optional require-match
initial-input history def) initial-input history def)
@ -1500,7 +1503,7 @@ Return nil otherwise."
(defvar tool-bar-mode) (defvar tool-bar-mode)
(defun gnus-tool-bar-update (&rest ignore) (defun gnus-tool-bar-update (&rest _ignore)
"Update the tool bar." "Update the tool bar."
(when (and (boundp 'tool-bar-mode) (when (and (boundp 'tool-bar-mode)
tool-bar-mode) tool-bar-mode)
@ -1526,7 +1529,7 @@ sequence, this is like `mapcar'. With several, it is like the Common Lisp
(if seqs2_n (if seqs2_n
(let* ((seqs (cons seq1 seqs2_n)) (let* ((seqs (cons seq1 seqs2_n))
(cnt 0) (cnt 0)
(heads (mapcar (lambda (seq) (heads (mapcar (lambda (_seq)
(make-symbol (concat "head" (make-symbol (concat "head"
(int-to-string (int-to-string
(setq cnt (1+ cnt)))))) (setq cnt (1+ cnt))))))
@ -1560,7 +1563,7 @@ sequence, this is like `mapcar'. With several, it is like the Common Lisp
((memq 'type lst) ((memq 'type lst)
(symbol-name system-type)) (symbol-name system-type))
(t nil))) (t nil)))
codename) ) ;; codename
(cond (cond
((not (memq 'emacs lst)) ((not (memq 'emacs lst))
nil) nil)
@ -1576,9 +1579,9 @@ sequence, this is like `mapcar'. With several, it is like the Common Lisp
empty directories from OLD-PATH." empty directories from OLD-PATH."
(when (file-exists-p old-path) (when (file-exists-p old-path)
(let* ((old-dir (file-name-directory old-path)) (let* ((old-dir (file-name-directory old-path))
(old-name (file-name-nondirectory old-path)) ;; (old-name (file-name-nondirectory old-path))
(new-dir (file-name-directory new-path)) (new-dir (file-name-directory new-path))
(new-name (file-name-nondirectory new-path)) ;; (new-name (file-name-nondirectory new-path))
temp) temp)
(gnus-make-directory new-dir) (gnus-make-directory new-dir)
(rename-file old-path new-path t) (rename-file old-path new-path t)

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

@ -1,4 +1,4 @@
;;; gnus-uu.el --- extract (uu)encoded files in Gnus ;;; gnus-uu.el --- extract (uu)encoded files in Gnus -*- lexical-binding: t; -*-
;; Copyright (C) 1985-1987, 1993-1998, 2000-2021 Free Software ;; Copyright (C) 1985-1987, 1993-1998, 2000-2021 Free Software
;; Foundation, Inc. ;; Foundation, Inc.
@ -977,7 +977,7 @@ When called interactively, prompt for REGEXP."
(defvar gnus-uu-binhex-end-line (defvar gnus-uu-binhex-end-line
":$") ":$")
(defun gnus-uu-binhex-article (buffer in-state) (defun gnus-uu-binhex-article (buffer _in-state)
(let (state start-char) (let (state start-char)
(with-current-buffer buffer (with-current-buffer buffer
(widen) (widen)
@ -1014,11 +1014,11 @@ When called interactively, prompt for REGEXP."
;; yEnc ;; yEnc
(defun gnus-uu-yenc-article (buffer in-state) (defun gnus-uu-yenc-article (_buffer _in-state)
(with-current-buffer gnus-original-article-buffer (with-current-buffer gnus-original-article-buffer
(widen) (widen)
(let ((file-name (yenc-extract-filename)) (let ((file-name (yenc-extract-filename))
state start-char) state) ;; start-char
(when (not file-name) (when (not file-name)
(setq state (list 'wrong-type))) (setq state (list 'wrong-type)))
@ -1046,7 +1046,7 @@ When called interactively, prompt for REGEXP."
;; PostScript ;; PostScript
(defun gnus-uu-decode-postscript-article (process-buffer in-state) (defun gnus-uu-decode-postscript-article (process-buffer _in-state)
(let ((state (list 'ok)) (let ((state (list 'ok))
start-char end-char file-name) start-char end-char file-name)
(with-current-buffer process-buffer (with-current-buffer process-buffer
@ -1278,13 +1278,15 @@ When called interactively, prompt for REGEXP."
(when dont-unmark-last-article (when dont-unmark-last-article
(setq gnus-uu-has-been-grabbed (list art)))))) (setq gnus-uu-has-been-grabbed (list art))))))
(defvar gnus-asynchronous)
;; This function takes a list of articles and a function to apply to ;; This function takes a list of articles and a function to apply to
;; each article grabbed. ;; each article grabbed.
;; ;;
;; This function returns a list of files decoded if the grabbing and ;; This function returns a list of files decoded if the grabbing and
;; the process-function has been successful and nil otherwise. ;; the process-function has been successful and nil otherwise.
(defun gnus-uu-grab-articles (articles process-function (defun gnus-uu-grab-articles (articles process-function
&optional sloppy limit no-errors) &optional sloppy limit _no-errors)
(require 'gnus-async) (require 'gnus-async)
(let ((state 'first) (let ((state 'first)
(gnus-asynchronous nil) (gnus-asynchronous nil)
@ -1452,10 +1454,10 @@ When called interactively, prompt for REGEXP."
(setq subject (substring subject (match-end 0))))) (setq subject (substring subject (match-end 0)))))
(or part ""))) (or part "")))
(defun gnus-uu-uudecode-sentinel (process event) (defun gnus-uu-uudecode-sentinel (process _event)
(delete-process (get-process process))) (delete-process (get-process process)))
(defun gnus-uu-uustrip-article (process-buffer in-state) (defun gnus-uu-uustrip-article (process-buffer _in-state)
;; Uudecodes a file asynchronously. ;; Uudecodes a file asynchronously.
(with-current-buffer process-buffer (with-current-buffer process-buffer
(let ((state (list 'wrong-type)) (let ((state (list 'wrong-type))
@ -1576,7 +1578,7 @@ Gnus might fail to display all of it.")
;; This function is used by `gnus-uu-grab-articles' to treat ;; This function is used by `gnus-uu-grab-articles' to treat
;; a shared article. ;; a shared article.
(defun gnus-uu-unshar-article (process-buffer in-state) (defun gnus-uu-unshar-article (process-buffer _in-state)
(let ((state (list 'ok)) (let ((state (list 'ok))
start-char) start-char)
(with-current-buffer process-buffer (with-current-buffer process-buffer

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

@ -1,4 +1,4 @@
;;; gnus-vm.el --- vm interface for Gnus ;;; gnus-vm.el --- vm interface for Gnus -*- lexical-binding: t; -*-
;; Copyright (C) 1994-2021 Free Software Foundation, Inc. ;; Copyright (C) 1994-2021 Free Software Foundation, Inc.

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

@ -1,4 +1,4 @@
;;; gnus-win.el --- window configuration functions for Gnus ;;; gnus-win.el --- window configuration functions for Gnus -*- lexical-binding: t; -*-
;; Copyright (C) 1996-2021 Free Software Foundation, Inc. ;; Copyright (C) 1996-2021 Free Software Foundation, Inc.
@ -246,7 +246,7 @@ See the Gnus manual for an explanation of the syntax used.")
;; return a new SPLIT. ;; return a new SPLIT.
(while (and (not (assq (car split) gnus-window-to-buffer)) (while (and (not (assq (car split) gnus-window-to-buffer))
(symbolp (car split)) (fboundp (car split))) (symbolp (car split)) (fboundp (car split)))
(setq split (eval split))) (setq split (eval split t)))
(let* ((type (car split)) (let* ((type (car split))
(subs (cddr split)) (subs (cddr split))
(len (if (eq type 'horizontal) (window-width) (window-height))) (len (if (eq type 'horizontal) (window-width) (window-height)))
@ -323,7 +323,7 @@ See the Gnus manual for an explanation of the syntax used.")
(setq sub (append (pop subs) nil)) (setq sub (append (pop subs) nil))
(while (and (not (assq (car sub) gnus-window-to-buffer)) (while (and (not (assq (car sub) gnus-window-to-buffer))
(symbolp (car sub)) (fboundp (car sub))) (symbolp (car sub)) (fboundp (car sub)))
(setq sub (eval sub))) (setq sub (eval sub t)))
(when sub (when sub
(push sub comp-subs) (push sub comp-subs)
(setq size (cadar comp-subs)) (setq size (cadar comp-subs))
@ -471,7 +471,7 @@ should have point."
;; return a new SPLIT. ;; return a new SPLIT.
(while (and (not (assq (car split) gnus-window-to-buffer)) (while (and (not (assq (car split) gnus-window-to-buffer))
(symbolp (car split)) (fboundp (car split))) (symbolp (car split)) (fboundp (car split)))
(setq split (eval split))) (setq split (eval split t)))
(setq type (elt split 0)) (setq type (elt split 0))
(cond (cond

2
lisp/gnus/gnus.el
View file

@ -3724,7 +3724,7 @@ just the host name."
depth (+ depth 1))) depth (+ depth 1)))
depth)))) depth))))
;; Separate foreign select method from group name and collapse. ;; Separate foreign select method from group name and collapse.
;; If method contains a server, collapse to non-domain server name, ;; If method contains a server, collapse to non-domain server name,
;; otherwise collapse to select method. ;; otherwise collapse to select method.
(let* ((colon (string-match ":" group)) (let* ((colon (string-match ":" group))
(server (and colon (substring group 0 colon))) (server (and colon (substring group 0 colon)))

2
lisp/gnus/gssapi.el
View file

@ -1,4 +1,4 @@
;;; gssapi.el --- GSSAPI/Kerberos 5 interface for Emacs ;;; gssapi.el --- GSSAPI/Kerberos 5 interface for Emacs -*- lexical-binding: t; -*-
;; Copyright (C) 2011-2021 Free Software Foundation, Inc. ;; Copyright (C) 2011-2021 Free Software Foundation, Inc.

4
lisp/gnus/legacy-gnus-agent.el
View file

@ -1,4 +1,4 @@
;;; gnus-agent.el --- Legacy unplugged support for Gnus ;;; gnus-agent.el --- Legacy unplugged support for Gnus -*- lexical-binding: t; -*-
;; Copyright (C) 2004-2021 Free Software Foundation, Inc. ;; Copyright (C) 2004-2021 Free Software Foundation, Inc.
@ -210,7 +210,7 @@ converted to the compressed format."
;; Therefore, hide the default prompt. ;; Therefore, hide the default prompt.
(gnus-convert-mark-converter-prompt 'gnus-agent-unlist-expire-days t) (gnus-convert-mark-converter-prompt 'gnus-agent-unlist-expire-days t)
(defun gnus-agent-unhook-expire-days (converting-to) (defun gnus-agent-unhook-expire-days (_converting-to)
"Remove every lambda from `gnus-group-prepare-hook' that mention the "Remove every lambda from `gnus-group-prepare-hook' that mention the
symbol `gnus-agent-do-once' in their definition. This should NOT be symbol `gnus-agent-do-once' in their definition. This should NOT be
necessary as gnus-agent.el no longer adds them. However, it is necessary as gnus-agent.el no longer adds them. However, it is

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

@ -1,4 +1,4 @@
;;; mail-source.el --- functions for fetching mail ;;; mail-source.el --- functions for fetching mail -*- lexical-binding: t; -*-
;; Copyright (C) 1999-2021 Free Software Foundation, Inc. ;; Copyright (C) 1999-2021 Free Software Foundation, Inc.
@ -403,16 +403,19 @@ of the second `let' form.
The variables bound and their default values are described by The variables bound and their default values are described by
the `mail-source-keyword-map' variable." the `mail-source-keyword-map' variable."
(declare (indent 1) (debug (sexp body))) (declare (indent 1) (debug (sexp body)))
`(let* ,(mail-source-bind-1 (car type-source)) ;; FIXME: Use lexical vars, i.e. don't initialize the vars inside
(mail-source-set-1 ,(cadr type-source)) ;; `mail-source-set-1' via `set'.
,@body)) (let ((bindings (mail-source-bind-1 (car type-source))))
`(with-suppressed-warnings ((lexical ,@(mapcar #'car bindings)))
(dlet ,bindings
(mail-source-set-1 ,(cadr type-source))
,@body))))
(defun mail-source-set-1 (source) (defun mail-source-set-1 (source)
(let* ((type (pop source)) (let* ((type (pop source))
(defaults (cdr (assq type mail-source-keyword-map))) (defaults (cdr (assq type mail-source-keyword-map)))
(search '(:max 1)) (search '(:max 1))
found default value keyword auth-info user-auth pass-auth) found default value keyword user-auth pass-auth) ;; auth-info
;; append to the search the useful info from the source and the defaults: ;; append to the search the useful info from the source and the defaults:
;; user, host, and port ;; user, host, and port
@ -494,9 +497,13 @@ the `mail-source-keyword-map' variable."
"Return a `let' form that binds all common variables. "Return a `let' form that binds all common variables.
See `mail-source-bind'." See `mail-source-bind'."
(declare (indent 1) (debug (sexp body))) (declare (indent 1) (debug (sexp body)))
`(let ,(mail-source-bind-common-1) ;; FIXME: AFAICT this is a Rube Goldberg'esque way to bind and initialize the
(mail-source-set-common-1 ,source) ;; `plugged` variable.
,@body)) (let ((bindings (mail-source-bind-common-1)))
`(with-suppressed-warnings ((lexical ,@(mapcar #'car bindings)))
(dlet ,bindings
(mail-source-set-common-1 ,source)
,@body))))
(defun mail-source-value (value) (defun mail-source-value (value)
"Return the value of VALUE." "Return the value of VALUE."
@ -506,7 +513,7 @@ See `mail-source-bind'."
value) value)
;; Function ;; Function
((and (listp value) (symbolp (car value)) (fboundp (car value))) ((and (listp value) (symbolp (car value)) (fboundp (car value)))
(eval value)) (eval value t))
;; Just return the value. ;; Just return the value.
(t (t
value))) value)))
@ -721,12 +728,13 @@ Deleting old (> %s day(s)) incoming mail file `%s'." diff bfile)
(declare-function gnus-get-buffer-create "gnus" (name)) (declare-function gnus-get-buffer-create "gnus" (name))
(defun mail-source-call-script (script) (defun mail-source-call-script (script)
(require 'gnus) (require 'gnus)
(let ((background nil) (let (;; (background nil)
(stderr (gnus-get-buffer-create " *mail-source-stderr*")) (stderr (gnus-get-buffer-create " *mail-source-stderr*"))
result) result)
(when (string-match "& *$" script) (when (string-match "& *$" script)
(setq script (substring script 0 (match-beginning 0)) (setq script (substring script 0 (match-beginning 0))
background 0)) ;; background 0
))
(setq result (setq result
(call-process shell-file-name nil stderr nil (call-process shell-file-name nil stderr nil
shell-command-switch script)) shell-command-switch script))
@ -810,14 +818,14 @@ Deleting old (> %s day(s)) incoming mail file `%s'." diff bfile)
;; The default is to use pop3.el. ;; The default is to use pop3.el.
(t (t
(require 'pop3) (require 'pop3)
(let ((pop3-password password) (dlet ((pop3-password password)
(pop3-maildrop user) (pop3-maildrop user)
(pop3-mailhost server) (pop3-mailhost server)
(pop3-port port) (pop3-port port)
(pop3-authentication-scheme (pop3-authentication-scheme
(if (eq authentication 'apop) 'apop 'pass)) (if (eq authentication 'apop) 'apop 'pass))
(pop3-stream-type stream) (pop3-stream-type stream)
(pop3-leave-mail-on-server leave)) (pop3-leave-mail-on-server leave))
(if (or debug-on-quit debug-on-error) (if (or debug-on-quit debug-on-error)
(save-excursion (pop3-movemail mail-source-crash-box)) (save-excursion (pop3-movemail mail-source-crash-box))
(condition-case err (condition-case err
@ -877,12 +885,12 @@ Deleting old (> %s day(s)) incoming mail file `%s'." diff bfile)
;; The default is to use pop3.el. ;; The default is to use pop3.el.
(t (t
(require 'pop3) (require 'pop3)
(let ((pop3-password password) (dlet ((pop3-password password)
(pop3-maildrop user) (pop3-maildrop user)
(pop3-mailhost server) (pop3-mailhost server)
(pop3-port port) (pop3-port port)
(pop3-authentication-scheme (pop3-authentication-scheme
(if (eq authentication 'apop) 'apop 'pass))) (if (eq authentication 'apop) 'apop 'pass)))
(if (or debug-on-quit debug-on-error) (if (or debug-on-quit debug-on-error)
(save-excursion (pop3-get-message-count)) (save-excursion (pop3-get-message-count))
(condition-case err (condition-case err

17
lisp/gnus/message.el
View file

@ -3675,7 +3675,7 @@ are null."
((functionp message-signature) ((functionp message-signature)
(funcall message-signature)) (funcall message-signature))
((listp message-signature) ((listp message-signature)
(eval message-signature)) (eval message-signature t))
(t message-signature))) (t message-signature)))
signature-file) signature-file)
(setq signature (setq signature
@ -3992,11 +3992,12 @@ Just \\[universal-argument] as argument means don't indent, insert no
prefix, and don't delete any headers." prefix, and don't delete any headers."
(interactive "P") (interactive "P")
;; eval the let forms contained in message-cite-style ;; eval the let forms contained in message-cite-style
(eval (let ((bindings (if (symbolp message-cite-style)
`(let ,(if (symbolp message-cite-style) (symbol-value message-cite-style)
(symbol-value message-cite-style) message-cite-style)))
message-cite-style) (cl-progv (mapcar #'car bindings)
(message--yank-original-internal ',arg)))) (mapcar (lambda (binding) (eval (cadr binding) t)) bindings)
(message--yank-original-internal arg))))
(defun message-yank-buffer (buffer) (defun message-yank-buffer (buffer)
"Insert BUFFER into the current buffer and quote it." "Insert BUFFER into the current buffer and quote it."
@ -4627,7 +4628,7 @@ Valid types are `send', `return', `exit', `kill' and `postpone'."
(funcall action)) (funcall action))
;; Something to be evalled. ;; Something to be evalled.
(t (t
(eval action)))))) (eval action t))))))
(defun message-send-mail-partially () (defun message-send-mail-partially ()
"Send mail as message/partial." "Send mail as message/partial."
@ -4943,7 +4944,7 @@ that instead."
;; Insert an extra newline if we need it to work around ;; Insert an extra newline if we need it to work around
;; Sun's bug that swallows newlines. ;; Sun's bug that swallows newlines.
(goto-char (1+ delimline)) (goto-char (1+ delimline))
(when (eval message-mailer-swallows-blank-line) (when (eval message-mailer-swallows-blank-line t)
(newline)) (newline))
(when message-interactive (when message-interactive
(with-current-buffer errbuf (with-current-buffer errbuf

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

@ -1,4 +1,4 @@
;;; mm-archive.el --- Functions for parsing archive files as MIME ;;; mm-archive.el --- Functions for parsing archive files as MIME -*- lexical-binding: t; -*-
;; Copyright (C) 2012-2021 Free Software Foundation, Inc. ;; Copyright (C) 2012-2021 Free Software Foundation, Inc.

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

@ -1,4 +1,4 @@
;;; mm-bodies.el --- Functions for decoding MIME things ;;; mm-bodies.el --- Functions for decoding MIME things -*- lexical-binding: t; -*-
;; Copyright (C) 1998-2021 Free Software Foundation, Inc. ;; Copyright (C) 1998-2021 Free Software Foundation, Inc.

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

@ -1,4 +1,4 @@
;;; mm-encode.el --- Functions for encoding MIME things ;;; mm-encode.el --- Functions for encoding MIME things -*- lexical-binding: t; -*-
;; Copyright (C) 1998-2021 Free Software Foundation, Inc. ;; Copyright (C) 1998-2021 Free Software Foundation, Inc.

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

@ -1,4 +1,4 @@
;;; mm-partial.el --- showing message/partial ;;; mm-partial.el --- showing message/partial -*- lexical-binding: t; -*-
;; Copyright (C) 2000-2021 Free Software Foundation, Inc. ;; Copyright (C) 2000-2021 Free Software Foundation, Inc.
@ -50,6 +50,8 @@
(push nhandles phandles)))))))) (push nhandles phandles))))))))
phandles)) phandles))
(defvar gnus-displaying-mime)
;;;###autoload ;;;###autoload
(defun mm-inline-partial (handle &optional no-display) (defun mm-inline-partial (handle &optional no-display)
"Show the partial part of HANDLE. "Show the partial part of HANDLE.
@ -60,7 +62,7 @@ If NO-DISPLAY is nil, display it. Otherwise, do nothing after replacing."
phandles phandles
(b (point)) (n 1) total (b (point)) (n 1) total
phandle nn ntotal phandle nn ntotal
gnus-displaying-mime handles buffer) gnus-displaying-mime handles) ;; buffer
(unless (mm-handle-cache handle) (unless (mm-handle-cache handle)
(unless id (unless id
(error "Can not find message/partial id")) (error "Can not find message/partial id"))

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

@ -1,4 +1,4 @@
;;; mm-url.el --- a wrapper of url functions/commands for Gnus ;;; mm-url.el --- a wrapper of url functions/commands for Gnus -*- lexical-binding: t; -*-
;; Copyright (C) 2001-2021 Free Software Foundation, Inc. ;; Copyright (C) 2001-2021 Free Software Foundation, Inc.

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

@ -160,7 +160,7 @@ is not available."
form form
(prog2 (prog2
;; Avoid errors... ;; Avoid errors...
(condition-case nil (eval form) (error nil)) (condition-case nil (eval form t) (error nil))
;; (message "Failed to eval `%s'" form)) ;; (message "Failed to eval `%s'" form))
(mm-coding-system-p cs) (mm-coding-system-p cs)
(message "Added charset `%s' via `mm-charset-eval-alist'" cs)) (message "Added charset `%s' via `mm-charset-eval-alist'" cs))

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

@ -1,4 +1,4 @@
;;; mm-view.el --- functions for viewing MIME objects ;;; mm-view.el --- functions for viewing MIME objects -*- lexical-binding: t; -*-
;; Copyright (C) 1998-2021 Free Software Foundation, Inc. ;; Copyright (C) 1998-2021 Free Software Foundation, Inc.
@ -137,7 +137,7 @@ This is only used if `mm-inline-large-images' is set to
(equal "multipart" (mm-handle-media-supertype elem))) (equal "multipart" (mm-handle-media-supertype elem)))
(mm-w3m-cid-retrieve-1 url elem))))) (mm-w3m-cid-retrieve-1 url elem)))))
(defun mm-w3m-cid-retrieve (url &rest args) (defun mm-w3m-cid-retrieve (url &rest _args)
"Insert a content pointed by URL if it has the cid: scheme." "Insert a content pointed by URL if it has the cid: scheme."
(when (string-match "\\`cid:" url) (when (string-match "\\`cid:" url)
(or (catch 'found-handle (or (catch 'found-handle
@ -149,6 +149,9 @@ This is only used if `mm-inline-large-images' is set to
nil nil
(message "Failed to find \"Content-ID: %s\"" url))))) (message "Failed to find \"Content-ID: %s\"" url)))))
(defvar w3m-force-redisplay)
(defvar w3m-safe-url-regexp)
(defun mm-inline-text-html-render-with-w3m (handle) (defun mm-inline-text-html-render-with-w3m (handle)
"Render a text/html part using emacs-w3m." "Render a text/html part using emacs-w3m."
(mm-setup-w3m) (mm-setup-w3m)
@ -396,7 +399,7 @@ This is only used if `mm-inline-large-images' is set to
(delete-region ,(copy-marker b t) (delete-region ,(copy-marker b t)
,(point-marker))))))) ,(point-marker)))))))
(defun mm-inline-audio (handle) (defun mm-inline-audio (_handle)
(message "Not implemented")) (message "Not implemented"))
(defun mm-view-message () (defun mm-view-message ()
@ -413,6 +416,10 @@ This is only used if `mm-inline-large-images' is set to
(fundamental-mode) (fundamental-mode)
(goto-char (point-min))) (goto-char (point-min)))
(defvar gnus-original-article-buffer)
(defvar gnus-article-prepare-hook)
(defvar gnus-displaying-mime)
(defun mm-inline-message (handle) (defun mm-inline-message (handle)
(let ((b (point)) (let ((b (point))
(bolp (bolp)) (bolp (bolp))

6
lisp/gnus/mml-sec.el
View file

@ -1,4 +1,4 @@
;;; mml-sec.el --- A package with security functions for MML documents ;;; mml-sec.el --- A package with security functions for MML documents -*- lexical-binding: t; -*-
;; Copyright (C) 2000-2021 Free Software Foundation, Inc. ;; Copyright (C) 2000-2021 Free Software Foundation, Inc.
@ -622,7 +622,7 @@ Passphrase caching in Emacs is NOT recommended. Use gpg-agent instead."
mml-smime-passphrase-cache-expiry) mml-smime-passphrase-cache-expiry)
mml-secure-passphrase-cache-expiry)))) mml-secure-passphrase-cache-expiry))))
(defun mml-secure-passphrase-callback (context key-id standard) (defun mml-secure-passphrase-callback (context key-id _standard)
"Ask for passphrase in CONTEXT for KEY-ID for STANDARD. "Ask for passphrase in CONTEXT for KEY-ID for STANDARD.
The passphrase is read and cached." The passphrase is read and cached."
;; Based on mml2015-epg-passphrase-callback. ;; Based on mml2015-epg-passphrase-callback.
@ -906,7 +906,7 @@ If no one is selected, symmetric encryption will be performed. "
(error "No recipient specified"))) (error "No recipient specified")))
recipients)) recipients))
(defun mml-secure-epg-encrypt (protocol cont &optional sign) (defun mml-secure-epg-encrypt (protocol _cont &optional sign)
;; Based on code appearing inside mml2015-epg-encrypt. ;; Based on code appearing inside mml2015-epg-encrypt.
(let* ((context (epg-make-context protocol)) (let* ((context (epg-make-context protocol))
(config (epg-find-configuration 'OpenPGP)) (config (epg-find-configuration 'OpenPGP))

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

@ -1,4 +1,4 @@
;;; mml-smime.el --- S/MIME support for MML ;;; mml-smime.el --- S/MIME support for MML -*- lexical-binding: t; -*-
;; Copyright (C) 2000-2021 Free Software Foundation, Inc. ;; Copyright (C) 2000-2021 Free Software Foundation, Inc.
@ -129,7 +129,7 @@ Whether the passphrase is cached at all is controlled by
(if func (if func
(funcall func handle ctl)))) (funcall func handle ctl))))
(defun mml-smime-openssl-sign (cont) (defun mml-smime-openssl-sign (_cont)
(when (null smime-keys) (when (null smime-keys)
(customize-variable 'smime-keys) (customize-variable 'smime-keys)
(error "No S/MIME keys configured, use customize to add your key")) (error "No S/MIME keys configured, use customize to add your key"))
@ -309,7 +309,7 @@ Whether the passphrase is cached at all is controlled by
(buffer-string) "\n"))))) (buffer-string) "\n")))))
handle) handle)
(defun mml-smime-openssl-verify-test (handle ctl) (defun mml-smime-openssl-verify-test (_handle _ctl)
smime-openssl-program) smime-openssl-program)
(defvar epg-user-id-alist) (defvar epg-user-id-alist)
@ -370,7 +370,7 @@ Content-Disposition: attachment; filename=smime.p7s
(defun mml-smime-epg-encrypt (cont) (defun mml-smime-epg-encrypt (cont)
(let* ((inhibit-redisplay t) ;FIXME: Why? (let* ((inhibit-redisplay t) ;FIXME: Why?
(boundary (mml-compute-boundary cont)) ;; (boundary (mml-compute-boundary cont))
(cipher (mml-secure-epg-encrypt 'CMS cont))) (cipher (mml-secure-epg-encrypt 'CMS cont)))
(delete-region (point-min) (point-max)) (delete-region (point-min) (point-max))
(goto-char (point-min)) (goto-char (point-min))
@ -388,7 +388,7 @@ Content-Disposition: attachment; filename=smime.p7m
(defun mml-smime-epg-verify (handle ctl) (defun mml-smime-epg-verify (handle ctl)
(catch 'error (catch 'error
(let ((inhibit-redisplay t) (let ((inhibit-redisplay t)
context plain signature-file part signature) context part signature) ;; plain signature-file
(when (or (null (setq part (mm-find-raw-part-by-type (when (or (null (setq part (mm-find-raw-part-by-type
ctl (or (mm-handle-multipart-ctl-parameter ctl (or (mm-handle-multipart-ctl-parameter
ctl 'protocol) ctl 'protocol)
@ -407,7 +407,8 @@ Content-Disposition: attachment; filename=smime.p7m
(setq part (replace-regexp-in-string "\n" "\r\n" part) (setq part (replace-regexp-in-string "\n" "\r\n" part)
context (epg-make-context 'CMS)) context (epg-make-context 'CMS))
(condition-case error (condition-case error
(setq plain (epg-verify-string context (mm-get-part signature) part)) ;; (setq plain
(epg-verify-string context (mm-get-part signature) part) ;;)
(error (error
(mm-sec-error 'gnus-info "Failed") (mm-sec-error 'gnus-info "Failed")
(mm-sec-status 'gnus-details (if (eq (car error) 'quit) (mm-sec-status 'gnus-details (if (eq (car error) 'quit)
@ -419,7 +420,7 @@ Content-Disposition: attachment; filename=smime.p7m
(epg-verify-result-to-string (epg-context-result-for context 'verify))) (epg-verify-result-to-string (epg-context-result-for context 'verify)))
handle))) handle)))
(defun mml-smime-epg-verify-test (handle ctl) (defun mml-smime-epg-verify-test (_handle _ctl)
t) t)
(provide 'mml-smime) (provide 'mml-smime)

41
lisp/gnus/mml.el
View file

@ -1,4 +1,4 @@
;;; mml.el --- A package for parsing and validating MML documents ;;; mml.el --- A package for parsing and validating MML documents -*- lexical-binding: t; -*-
;; Copyright (C) 1998-2021 Free Software Foundation, Inc. ;; Copyright (C) 1998-2021 Free Software Foundation, Inc.
@ -259,18 +259,19 @@ part. This is for the internal use, you should never modify the value.")
(list "sign" method "encrypt" method)) (list "sign" method "encrypt" method))
(t (t
(error "Unknown secure mode %s" mode)))) (error "Unknown secure mode %s" mode))))
(eval `(mml-insert-tag ,secure-mode (apply #'mml-insert-tag
,@tags secure-mode
,(if keyfile "keyfile") `(,@tags
,keyfile ,(if keyfile "keyfile")
,@(apply #'append ,keyfile
(mapcar (lambda (certfile) ,@(apply #'append
(list "certfile" certfile)) (mapcar (lambda (certfile)
certfiles)) (list "certfile" certfile))
,(if recipients "recipients") certfiles))
,recipients ,(if recipients "recipients")
,(if sender "sender") ,recipients
,sender)) ,(if sender "sender")
,sender))
;; restart the parse ;; restart the parse
(goto-char location))) (goto-char location)))
((looking-at "<#multipart") ((looking-at "<#multipart")
@ -1458,7 +1459,7 @@ will be computed and used."
(file-name-nondirectory file))) (file-name-nondirectory file)))
(goto-char head)))) (goto-char head))))
(defun mml-dnd-attach-file (uri action) (defun mml-dnd-attach-file (uri _action)
"Attach a drag and drop file. "Attach a drag and drop file.
Ask for type, description or disposition according to Ask for type, description or disposition according to
@ -1589,6 +1590,16 @@ Should be adopted if code in `message-send-mail' is changed."
(declare-function message-generate-headers "message" (headers)) (declare-function message-generate-headers "message" (headers))
(declare-function message-sort-headers "message" ()) (declare-function message-sort-headers "message" ())
(defvar gnus-newsgroup-name)
(defvar gnus-displaying-mime)
(defvar gnus-newsgroup-name)
(defvar gnus-article-prepare-hook)
(defvar gnus-newsgroup-charset)
(defvar gnus-original-article-buffer)
(defvar gnus-message-buffer)
(defvar message-this-is-news)
(defvar message-this-is-mail)
(defun mml-preview (&optional raw) (defun mml-preview (&optional raw)
"Display current buffer with Gnus, in a new buffer. "Display current buffer with Gnus, in a new buffer.
If RAW, display a raw encoded MIME message. If RAW, display a raw encoded MIME message.
@ -1708,7 +1719,7 @@ or the `pop-to-buffer' function."
cont) cont)
(let ((alist mml-tweak-sexp-alist)) (let ((alist mml-tweak-sexp-alist))
(while alist (while alist
(if (eval (caar alist)) (if (eval (caar alist) t)
(funcall (cdar alist) cont)) (funcall (cdar alist) cont))
(setq alist (cdr alist))))) (setq alist (cdr alist)))))
cont) cont)

13
lisp/gnus/mml1991.el
View file

@ -1,4 +1,4 @@
;;; mml1991.el --- Old PGP message format (RFC 1991) support for MML ;;; mml1991.el --- Old PGP message format (RFC 1991) support for MML -*- lexical-binding: t; -*-
;; Copyright (C) 1998-2021 Free Software Foundation, Inc. ;; Copyright (C) 1998-2021 Free Software Foundation, Inc.
@ -82,7 +82,7 @@ Whether the passphrase is cached at all is controlled by
(defvar mml1991-decrypt-function 'mailcrypt-decrypt) (defvar mml1991-decrypt-function 'mailcrypt-decrypt)
(defvar mml1991-verify-function 'mailcrypt-verify) (defvar mml1991-verify-function 'mailcrypt-verify)
(defun mml1991-mailcrypt-sign (cont) (defun mml1991-mailcrypt-sign (_cont)
(let ((text (current-buffer)) (let ((text (current-buffer))
headers signature headers signature
(result-buffer (get-buffer-create "*GPG Result*"))) (result-buffer (get-buffer-create "*GPG Result*")))
@ -118,7 +118,7 @@ Whether the passphrase is cached at all is controlled by
(declare-function mc-encrypt-generic "ext:mc-toplev" (declare-function mc-encrypt-generic "ext:mc-toplev"
(&optional recipients scheme start end from sign)) (&optional recipients scheme start end from sign))
(defun mml1991-mailcrypt-encrypt (cont &optional sign) (defun mml1991-mailcrypt-encrypt (_cont &optional sign)
(let ((text (current-buffer)) (let ((text (current-buffer))
(mc-pgp-always-sign (mc-pgp-always-sign
(or mc-pgp-always-sign (or mc-pgp-always-sign
@ -171,8 +171,9 @@ Whether the passphrase is cached at all is controlled by
(defvar pgg-default-user-id) (defvar pgg-default-user-id)
(defvar pgg-errors-buffer) (defvar pgg-errors-buffer)
(defvar pgg-output-buffer) (defvar pgg-output-buffer)
(defvar pgg-text-mode)
(defun mml1991-pgg-sign (cont) (defun mml1991-pgg-sign (_cont)
(let ((pgg-text-mode t) (let ((pgg-text-mode t)
(pgg-default-user-id (or (message-options-get 'mml-sender) (pgg-default-user-id (or (message-options-get 'mml-sender)
pgg-default-user-id)) pgg-default-user-id))
@ -209,7 +210,7 @@ Whether the passphrase is cached at all is controlled by
(buffer-string))) (buffer-string)))
t)) t))
(defun mml1991-pgg-encrypt (cont &optional sign) (defun mml1991-pgg-encrypt (_cont &optional sign)
(goto-char (point-min)) (goto-char (point-min))
(when (re-search-forward "^$" nil t) (when (re-search-forward "^$" nil t)
(let ((cte (save-restriction (let ((cte (save-restriction
@ -257,7 +258,7 @@ Whether the passphrase is cached at all is controlled by
(autoload 'epg-configuration "epg-config") (autoload 'epg-configuration "epg-config")
(autoload 'epg-expand-group "epg-config") (autoload 'epg-expand-group "epg-config")
(defun mml1991-epg-sign (cont) (defun mml1991-epg-sign (_cont)
(let ((inhibit-redisplay t) (let ((inhibit-redisplay t)
headers cte) headers cte)
;; Don't sign headers. ;; Don't sign headers.

24
lisp/gnus/mml2015.el
View file

@ -1,4 +1,4 @@
;;; mml2015.el --- MIME Security with Pretty Good Privacy (PGP) ;;; mml2015.el --- MIME Security with Pretty Good Privacy (PGP) -*- lexical-binding: t; -*-
;; Copyright (C) 2000-2021 Free Software Foundation, Inc. ;; Copyright (C) 2000-2021 Free Software Foundation, Inc.
@ -185,7 +185,7 @@ If set, it overrides the setting of `mml2015-sign-with-sender'."
(cadr err) (cadr err)
(format "%S" (cdr err)))) (format "%S" (cdr err))))
(defun mml2015-mailcrypt-decrypt (handle ctl) (defun mml2015-mailcrypt-decrypt (handle _ctl)
(catch 'error (catch 'error
(let (child handles result) (let (child handles result)
(unless (setq child (mm-find-part-by-type (unless (setq child (mm-find-part-by-type
@ -479,6 +479,7 @@ If set, it overrides the setting of `mml2015-sign-with-sender'."
(defvar pgg-default-user-id) (defvar pgg-default-user-id)
(defvar pgg-errors-buffer) (defvar pgg-errors-buffer)
(defvar pgg-output-buffer) (defvar pgg-output-buffer)
(defvar pgg-text-mode)
(autoload 'pgg-decrypt-region "pgg") (autoload 'pgg-decrypt-region "pgg")
(autoload 'pgg-verify-region "pgg") (autoload 'pgg-verify-region "pgg")
@ -486,10 +487,10 @@ If set, it overrides the setting of `mml2015-sign-with-sender'."
(autoload 'pgg-encrypt-region "pgg") (autoload 'pgg-encrypt-region "pgg")
(autoload 'pgg-parse-armor "pgg-parse") (autoload 'pgg-parse-armor "pgg-parse")
(defun mml2015-pgg-decrypt (handle ctl) (defun mml2015-pgg-decrypt (handle _ctl)
(catch 'error (catch 'error
(let ((pgg-errors-buffer mml2015-result-buffer) (let ((pgg-errors-buffer mml2015-result-buffer)
child handles result decrypt-status) child handles decrypt-status) ;; result
(unless (setq child (mm-find-part-by-type (unless (setq child (mm-find-part-by-type
(cdr handle) (cdr handle)
"application/octet-stream" nil t)) "application/octet-stream" nil t))
@ -751,7 +752,7 @@ If set, it overrides the setting of `mml2015-sign-with-sender'."
(let ((key-image (mml2015-epg-key-image key-id))) (let ((key-image (mml2015-epg-key-image key-id)))
(if (not key-image) (if (not key-image)
"" ""
(condition-case error (condition-case nil
(let ((result " ")) (let ((result " "))
(put-text-property (put-text-property
1 2 'display 1 2 'display
@ -770,10 +771,10 @@ If set, it overrides the setting of `mml2015-sign-with-sender'."
(defun mml2015-epg-verify-result-to-string (verify-result) (defun mml2015-epg-verify-result-to-string (verify-result)
(mapconcat #'mml2015-epg-signature-to-string verify-result "\n")) (mapconcat #'mml2015-epg-signature-to-string verify-result "\n"))
(defun mml2015-epg-decrypt (handle ctl) (defun mml2015-epg-decrypt (handle _ctl)
(catch 'error (catch 'error
(let ((inhibit-redisplay t) (let ((inhibit-redisplay t)
context plain child handles result decrypt-status) context plain child handles) ;; decrypt-status result
(unless (setq child (mm-find-part-by-type (unless (setq child (mm-find-part-by-type
(cdr handle) (cdr handle)
"application/octet-stream" nil t)) "application/octet-stream" nil t))
@ -851,7 +852,7 @@ If set, it overrides the setting of `mml2015-sign-with-sender'."
(defun mml2015-epg-verify (handle ctl) (defun mml2015-epg-verify (handle ctl)
(catch 'error (catch 'error
(let ((inhibit-redisplay t) (let ((inhibit-redisplay t)
context plain signature-file part signature) context part signature) ;; plain signature-file
(when (or (null (setq part (mm-find-raw-part-by-type (when (or (null (setq part (mm-find-raw-part-by-type
ctl (or (mm-handle-multipart-ctl-parameter ctl (or (mm-handle-multipart-ctl-parameter
ctl 'protocol) ctl 'protocol)
@ -866,7 +867,8 @@ If set, it overrides the setting of `mml2015-sign-with-sender'."
signature (mm-get-part signature) signature (mm-get-part signature)
context (epg-make-context)) context (epg-make-context))
(condition-case error (condition-case error
(setq plain (epg-verify-string context signature part)) ;; (setq plain
(epg-verify-string context signature part) ;;)
(error (error
(mm-sec-error 'gnus-info "Failed") (mm-sec-error 'gnus-info "Failed")
(mm-sec-status 'gnus-details (if (eq (car error) 'quit) (mm-sec-status 'gnus-details (if (eq (car error) 'quit)
@ -978,7 +980,7 @@ If set, it overrides the setting of `mml2015-sign-with-sender'."
handle))) handle)))
;;;###autoload ;;;###autoload
(defun mml2015-decrypt-test (handle ctl) (defun mml2015-decrypt-test (_handle _ctl)
mml2015-use) mml2015-use)
;;;###autoload ;;;###autoload
@ -990,7 +992,7 @@ If set, it overrides the setting of `mml2015-sign-with-sender'."
handle))) handle)))
;;;###autoload ;;;###autoload
(defun mml2015-verify-test (handle ctl) (defun mml2015-verify-test (_handle _ctl)
mml2015-use) mml2015-use)
;;;###autoload ;;;###autoload

14
lisp/gnus/nnagent.el
View file

@ -1,4 +1,4 @@
;;; nnagent.el --- offline backend for Gnus ;;; nnagent.el --- offline backend for Gnus -*- lexical-binding: t; -*-
;; Copyright (C) 1997-2021 Free Software Foundation, Inc. ;; Copyright (C) 1997-2021 Free Software Foundation, Inc.
@ -86,7 +86,7 @@
server dir) server dir)
t)))) t))))
(deffoo nnagent-retrieve-groups (groups &optional server) (deffoo nnagent-retrieve-groups (_groups &optional _server)
(save-excursion (save-excursion
(cond (cond
((file-exists-p (gnus-agent-lib-file "groups")) ((file-exists-p (gnus-agent-lib-file "groups"))
@ -106,13 +106,13 @@
(funcall (gnus-get-function gnus-command-method 'request-type) (funcall (gnus-get-function gnus-command-method 'request-type)
(gnus-group-real-name group) article))))) (gnus-group-real-name group) article)))))
(deffoo nnagent-request-newgroups (date server) (deffoo nnagent-request-newgroups (_date _server)
nil) nil)
(deffoo nnagent-request-update-info (group info &optional server) (deffoo nnagent-request-update-info (_group _info &optional _server)
nil) nil)
(deffoo nnagent-request-post (&optional server) (deffoo nnagent-request-post (&optional _server)
(gnus-agent-insert-meta-information 'news gnus-command-method) (gnus-agent-insert-meta-information 'news gnus-command-method)
(gnus-request-accept-article "nndraft:queue" nil t t)) (gnus-request-accept-article "nndraft:queue" nil t t))
@ -184,7 +184,7 @@
t) t)
'nov))) 'nov)))
(deffoo nnagent-request-expire-articles (articles group &optional server force) (deffoo nnagent-request-expire-articles (articles _group &optional _server _force)
articles) articles)
(deffoo nnagent-request-group (group &optional server dont-check info) (deffoo nnagent-request-group (group &optional server dont-check info)
@ -249,7 +249,7 @@
(nnoo-parent-function 'nnagent 'nnml-request-regenerate (nnoo-parent-function 'nnagent 'nnml-request-regenerate
(list (nnagent-server server)))) (list (nnagent-server server))))
(deffoo nnagent-retrieve-group-data-early (server infos) (deffoo nnagent-retrieve-group-data-early (_server _infos)
nil) nil)
;; Use nnml functions for just about everything. ;; Use nnml functions for just about everything.

22
lisp/gnus/nnbabyl.el
View file

@ -1,4 +1,4 @@
;;; nnbabyl.el --- rmail mbox access for Gnus ;;; nnbabyl.el --- rmail mbox access for Gnus -*- lexical-binding: t; -*-
;; Copyright (C) 1995-2021 Free Software Foundation, Inc. ;; Copyright (C) 1995-2021 Free Software Foundation, Inc.
@ -70,7 +70,7 @@
(nnoo-define-basics nnbabyl) (nnoo-define-basics nnbabyl)
(deffoo nnbabyl-retrieve-headers (articles &optional group server fetch-old) (deffoo nnbabyl-retrieve-headers (articles &optional group server _fetch-old)
(with-current-buffer nntp-server-buffer (with-current-buffer nntp-server-buffer
(erase-buffer) (erase-buffer)
(let ((number (length articles)) (let ((number (length articles))
@ -185,7 +185,7 @@
(cons nnbabyl-current-group article) (cons nnbabyl-current-group article)
(nnbabyl-article-group-number))))))) (nnbabyl-article-group-number)))))))
(deffoo nnbabyl-request-group (group &optional server dont-check info) (deffoo nnbabyl-request-group (group &optional server dont-check _info)
(let ((active (cadr (assoc group nnbabyl-group-alist)))) (let ((active (cadr (assoc group nnbabyl-group-alist))))
(save-excursion (save-excursion
(cond (cond
@ -224,10 +224,10 @@
(insert-buffer-substring in-buf))) (insert-buffer-substring in-buf)))
(nnmail-save-active nnbabyl-group-alist nnbabyl-active-file)))) (nnmail-save-active nnbabyl-group-alist nnbabyl-active-file))))
(deffoo nnbabyl-close-group (group &optional server) (deffoo nnbabyl-close-group (_group &optional _server)
t) t)
(deffoo nnbabyl-request-create-group (group &optional server args) (deffoo nnbabyl-request-create-group (group &optional _server _args)
(nnmail-activate 'nnbabyl) (nnmail-activate 'nnbabyl)
(unless (assoc group nnbabyl-group-alist) (unless (assoc group nnbabyl-group-alist)
(push (list group (cons 1 0)) (push (list group (cons 1 0))
@ -235,18 +235,20 @@
(nnmail-save-active nnbabyl-group-alist nnbabyl-active-file)) (nnmail-save-active nnbabyl-group-alist nnbabyl-active-file))
t) t)
(deffoo nnbabyl-request-list (&optional server) (deffoo nnbabyl-request-list (&optional _server)
(save-excursion (save-excursion
(nnmail-find-file nnbabyl-active-file) (nnmail-find-file nnbabyl-active-file)
(setq nnbabyl-group-alist (nnmail-get-active)) (setq nnbabyl-group-alist (nnmail-get-active))
t)) t))
(deffoo nnbabyl-request-newgroups (date &optional server) (deffoo nnbabyl-request-newgroups (_date &optional server)
(nnbabyl-request-list server)) (nnbabyl-request-list server))
(deffoo nnbabyl-request-list-newsgroups (&optional server) (deffoo nnbabyl-request-list-newsgroups (&optional _server)
(nnheader-report 'nnbabyl "nnbabyl: LIST NEWSGROUPS is not implemented.")) (nnheader-report 'nnbabyl "nnbabyl: LIST NEWSGROUPS is not implemented."))
(defvar nnml-current-directory)
(deffoo nnbabyl-request-expire-articles (deffoo nnbabyl-request-expire-articles
(articles newsgroup &optional server force) (articles newsgroup &optional server force)
(nnbabyl-possibly-change-newsgroup newsgroup server) (nnbabyl-possibly-change-newsgroup newsgroup server)
@ -293,7 +295,7 @@
(nconc rest articles)))) (nconc rest articles))))
(deffoo nnbabyl-request-move-article (deffoo nnbabyl-request-move-article
(article group server accept-form &optional last move-is-internal) (article group server accept-form &optional last _move-is-internal)
(let ((buf (gnus-get-buffer-create " *nnbabyl move*")) (let ((buf (gnus-get-buffer-create " *nnbabyl move*"))
result) result)
(and (and
@ -305,7 +307,7 @@
"^X-Gnus-Newsgroup:" "^X-Gnus-Newsgroup:"
(save-excursion (search-forward "\n\n" nil t) (point)) t) (save-excursion (search-forward "\n\n" nil t) (point)) t)
(delete-region (point-at-bol) (progn (forward-line 1) (point)))) (delete-region (point-at-bol) (progn (forward-line 1) (point))))
(setq result (eval accept-form)) (setq result (eval accept-form t))
(kill-buffer (current-buffer)) (kill-buffer (current-buffer))
result) result)
(save-excursion (save-excursion

23
lisp/gnus/nndiary.el
View file

@ -1,4 +1,4 @@
;;; nndiary.el --- A diary back end for Gnus ;;; nndiary.el --- A diary back end for Gnus -*- lexical-binding: t; -*-
;; Copyright (C) 1999-2021 Free Software Foundation, Inc. ;; Copyright (C) 1999-2021 Free Software Foundation, Inc.
@ -469,7 +469,7 @@ all. This may very well take some time.")
(cons (if group-num (car group-num) group) (cons (if group-num (car group-num) group)
(string-to-number (file-name-nondirectory path))))))) (string-to-number (file-name-nondirectory path)))))))
(deffoo nndiary-request-group (group &optional server dont-check info) (deffoo nndiary-request-group (group &optional server dont-check _info)
(let ((file-name-coding-system nnmail-pathname-coding-system)) (let ((file-name-coding-system nnmail-pathname-coding-system))
(cond (cond
((not (nndiary-possibly-change-directory group server)) ((not (nndiary-possibly-change-directory group server))
@ -503,11 +503,11 @@ all. This may very well take some time.")
(nndiary-possibly-change-directory group server) (nndiary-possibly-change-directory group server)
(nnmail-get-new-mail 'nndiary 'nndiary-save-nov nndiary-directory group))) (nnmail-get-new-mail 'nndiary 'nndiary-save-nov nndiary-directory group)))
(deffoo nndiary-close-group (group &optional server) (deffoo nndiary-close-group (_group &optional _server)
(setq nndiary-article-file-alist nil) (setq nndiary-article-file-alist nil)
t) t)
(deffoo nndiary-request-create-group (group &optional server args) (deffoo nndiary-request-create-group (group &optional server _args)
(nndiary-possibly-change-directory nil server) (nndiary-possibly-change-directory nil server)
(nnmail-activate 'nndiary) (nnmail-activate 'nndiary)
(cond (cond
@ -535,7 +535,7 @@ all. This may very well take some time.")
t)) t))
)) ))
(deffoo nndiary-request-list (&optional server) (deffoo nndiary-request-list (&optional _server)
(save-excursion (save-excursion
(let ((nnmail-file-coding-system nnmail-active-file-coding-system) (let ((nnmail-file-coding-system nnmail-active-file-coding-system)
(file-name-coding-system nnmail-pathname-coding-system)) (file-name-coding-system nnmail-pathname-coding-system))
@ -543,10 +543,10 @@ all. This may very well take some time.")
(setq nndiary-group-alist (nnmail-get-active)) (setq nndiary-group-alist (nnmail-get-active))
t)) t))
(deffoo nndiary-request-newgroups (date &optional server) (deffoo nndiary-request-newgroups (_date &optional server)
(nndiary-request-list server)) (nndiary-request-list server))
(deffoo nndiary-request-list-newsgroups (&optional server) (deffoo nndiary-request-list-newsgroups (&optional _server)
(save-excursion (save-excursion
(nnmail-find-file nndiary-newsgroups-file))) (nnmail-find-file nndiary-newsgroups-file)))
@ -590,7 +590,7 @@ all. This may very well take some time.")
(nconc rest articles))) (nconc rest articles)))
(deffoo nndiary-request-move-article (deffoo nndiary-request-move-article
(article group server accept-form &optional last move-is-internal) (article group server accept-form &optional last _move-is-internal)
(let ((buf (gnus-get-buffer-create " *nndiary move*")) (let ((buf (gnus-get-buffer-create " *nndiary move*"))
result) result)
(nndiary-possibly-change-directory group server) (nndiary-possibly-change-directory group server)
@ -603,7 +603,7 @@ all. This may very well take some time.")
nndiary-article-file-alist) nndiary-article-file-alist)
(with-current-buffer buf (with-current-buffer buf
(insert-buffer-substring nntp-server-buffer) (insert-buffer-substring nntp-server-buffer)
(setq result (eval accept-form)) (setq result (eval accept-form t))
(kill-buffer (current-buffer)) (kill-buffer (current-buffer))
result)) result))
(progn (progn
@ -766,7 +766,7 @@ all. This may very well take some time.")
;;; Interface optional functions ============================================ ;;; Interface optional functions ============================================
(deffoo nndiary-request-update-info (group info &optional server) (deffoo nndiary-request-update-info (group info &optional _server)
(nndiary-possibly-change-directory group) (nndiary-possibly-change-directory group)
(let ((timestamp (gnus-group-parameter-value (gnus-info-params info) (let ((timestamp (gnus-group-parameter-value (gnus-info-params info)
'timestamp t))) 'timestamp t)))
@ -1033,6 +1033,8 @@ all. This may very well take some time.")
;; Save the active file. ;; Save the active file.
(nnmail-save-active nndiary-group-alist nndiary-active-file)) (nnmail-save-active nndiary-group-alist nndiary-active-file))
(defvar nndiary-files) ; dynamically bound in nndiary-generate-nov-databases-1
(defun nndiary-generate-nov-databases-1 (dir &optional seen no-active) (defun nndiary-generate-nov-databases-1 (dir &optional seen no-active)
"Regenerate the NOV database in DIR." "Regenerate the NOV database in DIR."
(interactive "DRegenerate NOV in: ") (interactive "DRegenerate NOV in: ")
@ -1062,7 +1064,6 @@ all. This may very well take some time.")
(unless no-active (unless no-active
(nnmail-save-active nndiary-group-alist nndiary-active-file)))))) (nnmail-save-active nndiary-group-alist nndiary-active-file))))))
(defvar nndiary-files) ; dynamically bound in nndiary-generate-nov-databases-1
(defun nndiary-generate-active-info (dir) (defun nndiary-generate-active-info (dir)
;; Update the active info for this group. ;; Update the active info for this group.
(let* ((group (nnheader-file-to-group (let* ((group (nnheader-file-to-group

2
lisp/gnus/nndir.el
View file

@ -1,4 +1,4 @@
;;; nndir.el --- single directory newsgroup access for Gnus ;;; nndir.el --- single directory newsgroup access for Gnus -*- lexical-binding: t; -*-
;; Copyright (C) 1995-2021 Free Software Foundation, Inc. ;; Copyright (C) 1995-2021 Free Software Foundation, Inc.

22
lisp/gnus/nndoc.el
View file

@ -1,4 +1,4 @@
;;; nndoc.el --- single file access for Gnus ;;; nndoc.el --- single file access for Gnus -*- lexical-binding: t; -*-
;; Copyright (C) 1995-2021 Free Software Foundation, Inc. ;; Copyright (C) 1995-2021 Free Software Foundation, Inc.
@ -225,7 +225,7 @@ from the document.")
(nnoo-define-basics nndoc) (nnoo-define-basics nndoc)
(deffoo nndoc-retrieve-headers (articles &optional newsgroup server fetch-old) (deffoo nndoc-retrieve-headers (articles &optional newsgroup server _fetch-old)
(when (nndoc-possibly-change-buffer newsgroup server) (when (nndoc-possibly-change-buffer newsgroup server)
(with-current-buffer nntp-server-buffer (with-current-buffer nntp-server-buffer
(erase-buffer) (erase-buffer)
@ -280,7 +280,7 @@ from the document.")
(funcall nndoc-article-transform-function article)) (funcall nndoc-article-transform-function article))
t)))))) t))))))
(deffoo nndoc-request-group (group &optional server dont-check info) (deffoo nndoc-request-group (group &optional server dont-check _info)
"Select news GROUP." "Select news GROUP."
(let (number) (let (number)
(cond (cond
@ -301,7 +301,7 @@ from the document.")
(nndoc-request-group group server)) (nndoc-request-group group server))
t) t)
(deffoo nndoc-request-type (group &optional article) (deffoo nndoc-request-type (_group &optional article)
(cond ((not article) 'unknown) (cond ((not article) 'unknown)
(nndoc-post-type nndoc-post-type) (nndoc-post-type nndoc-post-type)
(t 'unknown))) (t 'unknown)))
@ -317,19 +317,19 @@ from the document.")
(setq nndoc-dissection-alist nil) (setq nndoc-dissection-alist nil)
t) t)
(deffoo nndoc-request-list (&optional server) (deffoo nndoc-request-list (&optional _server)
t) t)
(deffoo nndoc-request-newgroups (date &optional server) (deffoo nndoc-request-newgroups (_date &optional _server)
nil) nil)
(deffoo nndoc-request-list-newsgroups (&optional server) (deffoo nndoc-request-list-newsgroups (&optional _server)
nil) nil)
;;; Internal functions. ;;; Internal functions.
(defun nndoc-possibly-change-buffer (group source) (defun nndoc-possibly-change-buffer (group _source)
(let (buf) (let (buf)
(cond (cond
;; The current buffer is this group's buffer. ;; The current buffer is this group's buffer.
@ -677,7 +677,7 @@ from the document.")
(search-forward "\ncommit " nil t) (search-forward "\ncommit " nil t)
(search-forward "\nAuthor: " nil t))) (search-forward "\nAuthor: " nil t)))
(defun nndoc-transform-git-article (article) (defun nndoc-transform-git-article (_article)
(goto-char (point-min)) (goto-char (point-min))
(when (re-search-forward "^Author: " nil t) (when (re-search-forward "^Author: " nil t)
(replace-match "From: " t t))) (replace-match "From: " t t)))
@ -701,7 +701,7 @@ from the document.")
(re-search-forward "^\\\\\\\\\n\\(Paper\\( (\\*cross-listing\\*)\\)?: [a-zA-Z\\.-]+/[0-9]+\\|arXiv:\\)" nil t)) (re-search-forward "^\\\\\\\\\n\\(Paper\\( (\\*cross-listing\\*)\\)?: [a-zA-Z\\.-]+/[0-9]+\\|arXiv:\\)" nil t))
t)) t))
(defun nndoc-transform-lanl-gov-announce (article) (defun nndoc-transform-lanl-gov-announce (_article)
(let ((case-fold-search nil)) (let ((case-fold-search nil))
(goto-char (point-max)) (goto-char (point-max))
(when (re-search-backward "^\\\\\\\\ +( *\\([^ ]*\\) , *\\([^ ]*\\))" nil t) (when (re-search-backward "^\\\\\\\\ +( *\\([^ ]*\\) , *\\([^ ]*\\))" nil t)
@ -858,7 +858,7 @@ from the document.")
nil) nil)
(goto-char point)))) (goto-char point))))
(deffoo nndoc-request-accept-article (group &optional server last) (deffoo nndoc-request-accept-article (_group &optional _server _last)
nil) nil)
;;; ;;;

16
lisp/gnus/nndraft.el
View file

@ -1,4 +1,4 @@
;;; nndraft.el --- draft article access for Gnus ;;; nndraft.el --- draft article access for Gnus -*- lexical-binding: t; -*-
;; Copyright (C) 1995-2021 Free Software Foundation, Inc. ;; Copyright (C) 1995-2021 Free Software Foundation, Inc.
@ -79,7 +79,7 @@ are generated if and only if they are also in `message-draft-headers'."
server nndraft-directory) server nndraft-directory)
t))) t)))
(deffoo nndraft-retrieve-headers (articles &optional group server fetch-old) (deffoo nndraft-retrieve-headers (articles &optional group server _fetch-old)
(nndraft-possibly-change-group group) (nndraft-possibly-change-group group)
(with-current-buffer nntp-server-buffer (with-current-buffer nntp-server-buffer
(erase-buffer) (erase-buffer)
@ -108,7 +108,7 @@ are generated if and only if they are also in `message-draft-headers'."
(nnheader-fold-continuation-lines) (nnheader-fold-continuation-lines)
'headers)))) 'headers))))
(deffoo nndraft-request-article (id &optional group server buffer) (deffoo nndraft-request-article (id &optional group _server buffer)
(nndraft-possibly-change-group group) (nndraft-possibly-change-group group)
(when (numberp id) (when (numberp id)
;; We get the newest file of the auto-saved file and the ;; We get the newest file of the auto-saved file and the
@ -145,7 +145,7 @@ are generated if and only if they are also in `message-draft-headers'."
;;(message-remove-header "date") ;;(message-remove-header "date")
t)) t))
(deffoo nndraft-request-update-info (group info &optional server) (deffoo nndraft-request-update-info (group info &optional _server)
(nndraft-possibly-change-group group) (nndraft-possibly-change-group group)
(setf (gnus-info-read info) (setf (gnus-info-read info)
(gnus-update-read-articles (gnus-update-read-articles
@ -210,7 +210,7 @@ are generated if and only if they are also in `message-draft-headers'."
'exit 'postpone 'kill) 'exit 'postpone 'kill)
article)) article))
(deffoo nndraft-request-group (group &optional server dont-check info) (deffoo nndraft-request-group (group &optional server dont-check _info)
(nndraft-possibly-change-group group) (nndraft-possibly-change-group group)
(unless dont-check (unless dont-check
(let* ((pathname (nnmail-group-pathname group nndraft-directory)) (let* ((pathname (nnmail-group-pathname group nndraft-directory))
@ -229,7 +229,7 @@ are generated if and only if they are also in `message-draft-headers'."
(list group server dont-check))) (list group server dont-check)))
(deffoo nndraft-request-move-article (article group server accept-form (deffoo nndraft-request-move-article (article group server accept-form
&optional last move-is-internal) &optional _last _move-is-internal)
(nndraft-possibly-change-group group) (nndraft-possibly-change-group group)
(let ((buf (gnus-get-buffer-create " *nndraft move*")) (let ((buf (gnus-get-buffer-create " *nndraft move*"))
result) result)
@ -238,7 +238,7 @@ are generated if and only if they are also in `message-draft-headers'."
(with-current-buffer buf (with-current-buffer buf
(erase-buffer) (erase-buffer)
(insert-buffer-substring nntp-server-buffer) (insert-buffer-substring nntp-server-buffer)
(setq result (eval accept-form)) (setq result (eval accept-form t))
(kill-buffer (current-buffer)) (kill-buffer (current-buffer))
result) result)
(null (nndraft-request-expire-articles (list article) group server 'force)) (null (nndraft-request-expire-articles (list article) group server 'force))
@ -292,7 +292,7 @@ are generated if and only if they are also in `message-draft-headers'."
(nnoo-parent-function 'nndraft 'nnmh-request-replace-article (nnoo-parent-function 'nndraft 'nnmh-request-replace-article
(list article group buffer)))) (list article group buffer))))
(deffoo nndraft-request-create-group (group &optional server args) (deffoo nndraft-request-create-group (group &optional _server _args)
(nndraft-possibly-change-group group) (nndraft-possibly-change-group group)
(if (file-exists-p nndraft-current-directory) (if (file-exists-p nndraft-current-directory)
(if (file-directory-p nndraft-current-directory) (if (file-directory-p nndraft-current-directory)

16
lisp/gnus/nneething.el
View file

@ -1,4 +1,4 @@
;;; nneething.el --- arbitrary file access for Gnus ;;; nneething.el --- arbitrary file access for Gnus -*- lexical-binding: t; -*-
;; Copyright (C) 1995-2021 Free Software Foundation, Inc. ;; Copyright (C) 1995-2021 Free Software Foundation, Inc.
@ -77,7 +77,7 @@ included.")
(nnoo-define-basics nneething) (nnoo-define-basics nneething)
(deffoo nneething-retrieve-headers (articles &optional group server fetch-old) (deffoo nneething-retrieve-headers (articles &optional group _server _fetch-old)
(nneething-possibly-change-directory group) (nneething-possibly-change-directory group)
(with-current-buffer nntp-server-buffer (with-current-buffer nntp-server-buffer
@ -114,7 +114,7 @@ included.")
(nnheader-fold-continuation-lines) (nnheader-fold-continuation-lines)
'headers)))) 'headers))))
(deffoo nneething-request-article (id &optional group server buffer) (deffoo nneething-request-article (id &optional group _server buffer)
(nneething-possibly-change-directory group) (nneething-possibly-change-directory group)
(let ((file (unless (stringp id) (let ((file (unless (stringp id)
(nneething-file-name id))) (nneething-file-name id)))
@ -143,7 +143,7 @@ included.")
(insert "\n")) (insert "\n"))
t)))) t))))
(deffoo nneething-request-group (group &optional server dont-check info) (deffoo nneething-request-group (group &optional server dont-check _info)
(nneething-possibly-change-directory group server) (nneething-possibly-change-directory group server)
(unless dont-check (unless dont-check
(nneething-create-mapping) (nneething-create-mapping)
@ -156,16 +156,16 @@ included.")
group))) group)))
t) t)
(deffoo nneething-request-list (&optional server dir) (deffoo nneething-request-list (&optional _server _dir)
(nnheader-report 'nneething "LIST is not implemented.")) (nnheader-report 'nneething "LIST is not implemented."))
(deffoo nneething-request-newgroups (date &optional server) (deffoo nneething-request-newgroups (_date &optional _server)
(nnheader-report 'nneething "NEWSGROUPS is not implemented.")) (nnheader-report 'nneething "NEWSGROUPS is not implemented."))
(deffoo nneething-request-type (group &optional article) (deffoo nneething-request-type (_group &optional _article)
'unknown) 'unknown)
(deffoo nneething-close-group (group &optional server) (deffoo nneething-close-group (_group &optional _server)
(setq nneething-current-directory nil) (setq nneething-current-directory nil)
t) t)

19
lisp/gnus/nnfolder.el
View file

@ -1,4 +1,4 @@
;;; nnfolder.el --- mail folder access for Gnus ;;; nnfolder.el --- mail folder access for Gnus -*- lexical-binding: t; -*-
;; Copyright (C) 1995-2021 Free Software Foundation, Inc. ;; Copyright (C) 1995-2021 Free Software Foundation, Inc.
@ -261,7 +261,7 @@ all. This may very well take some time.")
(point) (point-at-eol))) (point) (point-at-eol)))
-1)))))))) -1))))))))
(deffoo nnfolder-request-group (group &optional server dont-check info) (deffoo nnfolder-request-group (group &optional server dont-check _info)
(nnfolder-possibly-change-group group server t) (nnfolder-possibly-change-group group server t)
(save-excursion (save-excursion
(cond ((not (assoc group nnfolder-group-alist)) (cond ((not (assoc group nnfolder-group-alist))
@ -314,7 +314,7 @@ all. This may very well take some time.")
;; over the buffer again unless we add new mail to it or modify it in some ;; over the buffer again unless we add new mail to it or modify it in some
;; way. ;; way.
(deffoo nnfolder-close-group (group &optional server force) (deffoo nnfolder-close-group (group &optional _server _force)
;; Make sure we _had_ the group open. ;; Make sure we _had_ the group open.
(when (or (assoc group nnfolder-buffer-alist) (when (or (assoc group nnfolder-buffer-alist)
(equal group nnfolder-current-group)) (equal group nnfolder-current-group))
@ -342,7 +342,7 @@ all. This may very well take some time.")
nnfolder-current-buffer nil) nnfolder-current-buffer nil)
t) t)
(deffoo nnfolder-request-create-group (group &optional server args) (deffoo nnfolder-request-create-group (group &optional server _args)
(nnfolder-possibly-change-group nil server) (nnfolder-possibly-change-group nil server)
(nnmail-activate 'nnfolder) (nnmail-activate 'nnfolder)
(cond ((zerop (length group)) (cond ((zerop (length group))
@ -369,7 +369,7 @@ all. This may very well take some time.")
(setq nnfolder-group-alist (nnmail-get-active))) (setq nnfolder-group-alist (nnmail-get-active)))
t)) t))
(deffoo nnfolder-request-newgroups (date &optional server) (deffoo nnfolder-request-newgroups (_date &optional server)
(nnfolder-possibly-change-group nil server) (nnfolder-possibly-change-group nil server)
(nnfolder-request-list server)) (nnfolder-request-list server))
@ -394,12 +394,13 @@ all. This may very well take some time.")
(let ((newnum (string-to-number (match-string 0)))) (let ((newnum (string-to-number (match-string 0))))
(if (nnmail-within-headers-p) (if (nnmail-within-headers-p)
(push newnum numbers)))) (push newnum numbers))))
;; The article numbers are increasing, so this result is sorted. ;; The article numbers are increasing, so this result is sorted.
(nreverse numbers))))) (nreverse numbers)))))
(autoload 'gnus-request-group "gnus-int") (autoload 'gnus-request-group "gnus-int")
(declare-function gnus-request-create-group "gnus-int" (declare-function gnus-request-create-group "gnus-int"
(group &optional gnus-command-method args)) (group &optional gnus-command-method args))
(defvar nnfolder-current-directory)
(deffoo nnfolder-request-expire-articles (articles newsgroup (deffoo nnfolder-request-expire-articles (articles newsgroup
&optional server force) &optional server force)
@ -462,7 +463,7 @@ all. This may very well take some time.")
(gnus-sorted-difference articles (nreverse deleted-articles))))) (gnus-sorted-difference articles (nreverse deleted-articles)))))
(deffoo nnfolder-request-move-article (article group server accept-form (deffoo nnfolder-request-move-article (article group server accept-form
&optional last move-is-internal) &optional last _move-is-internal)
(save-excursion (save-excursion
(let ((buf (gnus-get-buffer-create " *nnfolder move*")) (let ((buf (gnus-get-buffer-create " *nnfolder move*"))
result) result)
@ -477,7 +478,7 @@ all. This may very well take some time.")
(save-excursion (and (search-forward "\n\n" nil t) (point))) (save-excursion (and (search-forward "\n\n" nil t) (point)))
t) t)
(gnus-delete-line)) (gnus-delete-line))
(setq result (eval accept-form)) (setq result (eval accept-form t))
(kill-buffer buf) (kill-buffer buf)
result) result)
(save-excursion (save-excursion
@ -498,7 +499,7 @@ all. This may very well take some time.")
(save-excursion (save-excursion
(nnfolder-possibly-change-group group server) (nnfolder-possibly-change-group group server)
(nnmail-check-syntax) (nnmail-check-syntax)
(let ((buf (current-buffer)) (let (;; (buf (current-buffer))
result art-group) result art-group)
(goto-char (point-min)) (goto-char (point-min))
(when (looking-at "X-From-Line: ") (when (looking-at "X-From-Line: ")

2
lisp/gnus/nngateway.el
View file

@ -1,4 +1,4 @@
;;; nngateway.el --- posting news via mail gateways ;;; nngateway.el --- posting news via mail gateways -*- lexical-binding: t; -*-
;; Copyright (C) 1996-2021 Free Software Foundation, Inc. ;; Copyright (C) 1996-2021 Free Software Foundation, Inc.

2
lisp/gnus/nnheader.el
View file

@ -1,4 +1,4 @@
;;; nnheader.el --- header access macros for Gnus and its backends ;;; nnheader.el --- header access macros for Gnus and its backends -*- lexical-binding: t; -*-
;; Copyright (C) 1987-1990, 1993-1998, 2000-2021 Free Software ;; Copyright (C) 1987-1990, 1993-1998, 2000-2021 Free Software
;; Foundation, Inc. ;; Foundation, Inc.

6
lisp/gnus/nnimap.el
View file

@ -1,4 +1,4 @@
;;; nnimap.el --- IMAP interface for Gnus ;;; nnimap.el --- IMAP interface for Gnus -*- lexical-binding: t; -*-
;; Copyright (C) 2010-2021 Free Software Foundation, Inc. ;; Copyright (C) 2010-2021 Free Software Foundation, Inc.
@ -1004,7 +1004,7 @@ during splitting, which may be slow."
internal-move-group server message-id internal-move-group server message-id
nnimap-request-articles-find-limit))))) nnimap-request-articles-find-limit)))))
;; Move the article to a different method. ;; Move the article to a different method.
(when-let* ((result (eval accept-form))) (when-let* ((result (eval accept-form t)))
(nnimap-change-group group server) (nnimap-change-group group server)
(nnimap-delete-article article) (nnimap-delete-article article)
result)))))) result))))))
@ -1165,7 +1165,7 @@ If LIMIT, first try to limit the search to the N last articles."
7 "Article marked for deletion, but not expunged.") 7 "Article marked for deletion, but not expunged.")
nil)))) nil))))
(deffoo nnimap-request-scan (&optional group server) (deffoo nnimap-request-scan (&optional _group server)
(when (and (nnimap-change-group nil server) (when (and (nnimap-change-group nil server)
nnimap-inbox nnimap-inbox
nnimap-split-methods) nnimap-split-methods)

14
lisp/gnus/nnmail.el
View file

@ -1,4 +1,4 @@
;;; nnmail.el --- mail support functions for the Gnus mail backends ;;; nnmail.el --- mail support functions for the Gnus mail backends -*- lexical-binding: t; -*-
;; Copyright (C) 1995-2021 Free Software Foundation, Inc. ;; Copyright (C) 1995-2021 Free Software Foundation, Inc.
@ -598,7 +598,7 @@ These will be logged to the \"*nnmail split*\" buffer."
(defun nnmail-request-post (&optional server) (defun nnmail-request-post (&optional _server)
(mail-send-and-exit nil)) (mail-send-and-exit nil))
(defvar nnmail-file-coding-system 'raw-text (defvar nnmail-file-coding-system 'raw-text
@ -664,7 +664,7 @@ nn*-request-list should have been called before calling this function."
(let ((buffer (current-buffer)) (let ((buffer (current-buffer))
group-assoc group max min) group-assoc group max min)
(while (not (eobp)) (while (not (eobp))
(condition-case err (condition-case nil
(progn (progn
(narrow-to-region (point) (point-at-eol)) (narrow-to-region (point) (point-at-eol))
(setq group (read buffer) (setq group (read buffer)
@ -1332,7 +1332,7 @@ Eudora has a broken References line, but an OK In-Reply-To."
(declare-function gnus-activate-group "gnus-start" (declare-function gnus-activate-group "gnus-start"
(group &optional scan dont-check method dont-sub-check)) (group &optional scan dont-check method dont-sub-check))
(defun nnmail-do-request-post (accept-func &optional server) (defun nnmail-do-request-post (accept-func &optional _server)
"Utility function to directly post a message to an nnmail-derived group. "Utility function to directly post a message to an nnmail-derived group.
Calls ACCEPT-FUNC (which should be `nnchoke-request-accept-article') Calls ACCEPT-FUNC (which should be `nnchoke-request-accept-article')
to actually put the message in the right group." to actually put the message in the right group."
@ -1397,7 +1397,7 @@ See the documentation for the variable `nnmail-split-fancy' for details."
;; Builtin : operation. ;; Builtin : operation.
((eq (car split) ':) ((eq (car split) ':)
(nnmail-log-split split) (nnmail-log-split split)
(nnmail-split-it (save-excursion (eval (cdr split))))) (nnmail-split-it (save-excursion (eval (cdr split) t))))
;; Builtin ! operation. ;; Builtin ! operation.
((eq (car split) '!) ((eq (car split) '!)
@ -1783,7 +1783,7 @@ be called once per group or once for all groups."
(assq 'directory mail-sources))) (assq 'directory mail-sources)))
(defun nnmail-get-new-mail-1 (method exit-func temp (defun nnmail-get-new-mail-1 (method exit-func temp
group in-group spool-func) group _in-group spool-func)
(let* ((sources mail-sources) (let* ((sources mail-sources)
fetching-sources fetching-sources
(i 0) (i 0)
@ -1918,7 +1918,7 @@ If TIME is nil, then return the cutoff time for oldness instead."
(cdr group-art)) (cdr group-art))
(gnus-group-mark-article-read target (cdr group-art)))))))) (gnus-group-mark-article-read target (cdr group-art))))))))
(defun nnmail-fancy-expiry-target (group) (defun nnmail-fancy-expiry-target (_group)
"Return a target expiry group determined by `nnmail-fancy-expiry-targets'." "Return a target expiry group determined by `nnmail-fancy-expiry-targets'."
(let* (header (let* (header
(case-fold-search nil) (case-fold-search nil)

53
lisp/gnus/nnmairix.el
View file

@ -1,4 +1,4 @@
;;; nnmairix.el --- Mairix back end for Gnus, the Emacs newsreader ;;; nnmairix.el --- Mairix back end for Gnus, the Emacs newsreader -*- lexical-binding: t; -*-
;; Copyright (C) 2007-2021 Free Software Foundation, Inc. ;; Copyright (C) 2007-2021 Free Software Foundation, Inc.
@ -404,7 +404,7 @@ Other back ends might or might not work.")
(setq nnmairix-current-server server) (setq nnmairix-current-server server)
(nnoo-change-server 'nnmairix server definitions)) (nnoo-change-server 'nnmairix server definitions))
(deffoo nnmairix-request-group (group &optional server fast info) (deffoo nnmairix-request-group (group &optional server fast _info)
;; Call mairix and request group on back end server ;; Call mairix and request group on back end server
(when server (nnmairix-open-server server)) (when server (nnmairix-open-server server))
(let* ((qualgroup (if server (let* ((qualgroup (if server
@ -417,7 +417,7 @@ Other back ends might or might not work.")
(backendmethod (gnus-server-to-method (backendmethod (gnus-server-to-method
(format "%s:%s" (symbol-name nnmairix-backend) (format "%s:%s" (symbol-name nnmairix-backend)
nnmairix-backend-server))) nnmairix-backend-server)))
rval mfolder folderpath args) rval mfolder folderpath) ;; args
(cond (cond
((not folder) ((not folder)
;; No folder parameter -> error ;; No folder parameter -> error
@ -497,12 +497,12 @@ Other back ends might or might not work.")
nil)))))) nil))))))
(deffoo nnmairix-request-create-group (group &optional server args) (deffoo nnmairix-request-create-group (group &optional server _args)
(let ((qualgroup (if server (gnus-group-prefixed-name group (list 'nnmairix server)) (let ((qualgroup (if server (gnus-group-prefixed-name group (list 'nnmairix server))
group)) group))
(exist t) (exist t)
(count 0) (count 0)
groupname info) groupname) ;; info
(when server (nnmairix-open-server server)) (when server (nnmairix-open-server server))
(gnus-group-add-parameter qualgroup '(query . nil)) (gnus-group-add-parameter qualgroup '(query . nil))
(gnus-group-add-parameter qualgroup '(threads . nil)) (gnus-group-add-parameter qualgroup '(threads . nil))
@ -561,7 +561,7 @@ Other back ends might or might not work.")
(deffoo nnmairix-request-list (&optional server) (deffoo nnmairix-request-list (&optional server)
(when server (nnmairix-open-server server)) (when server (nnmairix-open-server server))
(if (nnmairix-call-backend "request-list" nnmairix-backend-server) (if (nnmairix-call-backend "request-list" nnmairix-backend-server)
(let (cpoint cur qualgroup folder) (let (cpoint cur qualgroup) ;; folder
(with-current-buffer nntp-server-buffer (with-current-buffer nntp-server-buffer
(goto-char (point-min)) (goto-char (point-min))
(setq cpoint (point)) (setq cpoint (point))
@ -590,7 +590,7 @@ Other back ends might or might not work.")
(nnmairix-open-server server)) (nnmairix-open-server server))
(let* ((qualgroup (gnus-group-prefixed-name group (list 'nnmairix nnmairix-current-server))) (let* ((qualgroup (gnus-group-prefixed-name group (list 'nnmairix nnmairix-current-server)))
(propmarks (gnus-group-get-parameter qualgroup 'propmarks)) (propmarks (gnus-group-get-parameter qualgroup 'propmarks))
(propto (gnus-group-get-parameter qualgroup 'propto t)) ;; (propto (gnus-group-get-parameter qualgroup 'propto t))
(corr (nnmairix-get-numcorr group server)) (corr (nnmairix-get-numcorr group server))
(folder (nnmairix-get-backend-folder group server))) (folder (nnmairix-get-backend-folder group server)))
(save-excursion (save-excursion
@ -598,7 +598,7 @@ Other back ends might or might not work.")
(let ((type (nth 1 cur)) (let ((type (nth 1 cur))
(cmdmarks (nth 2 cur)) (cmdmarks (nth 2 cur))
(range (gnus-uncompress-range (nth 0 cur))) (range (gnus-uncompress-range (nth 0 cur)))
mid ogroup number method temp) mid ogroup temp) ;; number method
(when (and corr (when (and corr
(not (zerop (cadr corr)))) (not (zerop (cadr corr))))
(setq range (mapcar (lambda (arg) (setq range (mapcar (lambda (arg)
@ -661,7 +661,7 @@ Other back ends might or might not work.")
(nnmairix-open-server server)) (nnmairix-open-server server))
(let* ((qualgroup (gnus-group-prefixed-name group (list 'nnmairix nnmairix-current-server))) (let* ((qualgroup (gnus-group-prefixed-name group (list 'nnmairix nnmairix-current-server)))
(propmarks (gnus-group-get-parameter qualgroup 'propmarks)) (propmarks (gnus-group-get-parameter qualgroup 'propmarks))
method) ) ;; method
(when (and propmarks (when (and propmarks
nnmairix-marks-cache) nnmairix-marks-cache)
(when (or (eq nnmairix-propagate-marks-upon-close t) (when (or (eq nnmairix-propagate-marks-upon-close t)
@ -690,7 +690,7 @@ Other back ends might or might not work.")
(corr (nnmairix-get-numcorr group server)) (corr (nnmairix-get-numcorr group server))
(docorr (and corr (not (zerop (cadr corr))))) (docorr (and corr (not (zerop (cadr corr)))))
(folderinfo `(,group 1 ((1 . 1)))) (folderinfo `(,group 1 ((1 . 1))))
readrange marks) ) ;; readrange marks
(when (and propmarks (when (and propmarks
nnmairix-propagate-marks-to-nnmairix-groups) nnmairix-propagate-marks-to-nnmairix-groups)
;; these groups are not subscribed, so we have to ask the back end directly ;; these groups are not subscribed, so we have to ask the back end directly
@ -778,7 +778,7 @@ called interactively, user will be asked for parameters."
(interactive) (interactive)
(let ((char-header nnmairix-interactive-query-parameters) (let ((char-header nnmairix-interactive-query-parameters)
(server (nnmairix-backend-to-server gnus-current-select-method)) (server (nnmairix-backend-to-server gnus-current-select-method))
query achar header finished group threads cq) query achar header finished group threads) ;; cq
(when (or (not (gnus-buffer-live-p gnus-article-buffer)) (when (or (not (gnus-buffer-live-p gnus-article-buffer))
(not (gnus-buffer-live-p gnus-summary-buffer))) (not (gnus-buffer-live-p gnus-summary-buffer)))
(error "No article or summary buffer")) (error "No article or summary buffer"))
@ -796,7 +796,8 @@ called interactively, user will be asked for parameters."
(setq achar nil))) (setq achar nil)))
(set-buffer gnus-article-buffer) (set-buffer gnus-article-buffer)
(setq header nil) (setq header nil)
(when (setq cq (nth 1 (assoc achar char-header))) (when ;; (setq cq
(nth 1 (assoc achar char-header)) ;;)
(setq header (setq header
(nnmairix-replace-illegal-chars (nnmairix-replace-illegal-chars
(gnus-fetch-field (nth 1 (assoc achar char-header)))))) (gnus-fetch-field (nth 1 (assoc achar char-header))))))
@ -827,7 +828,7 @@ All necessary information will be queried from the user."
(hidden (and (string-match "^nn\\(imap\\|maildir\\)$" backend) (hidden (and (string-match "^nn\\(imap\\|maildir\\)$" backend)
(y-or-n-p (y-or-n-p
"Does the back end server work with maildir++ (i.e. hidden directories)? "))) "Does the back end server work with maildir++ (i.e. hidden directories)? ")))
create) ) ;; create
(apply (intern (format "%s-%s" backend "open-server")) (apply (intern (format "%s-%s" backend "open-server"))
(list servername)) (list servername))
@ -1009,7 +1010,7 @@ before deleting a group on the back end. SERVER specifies nnmairix server."
(if (nnmairix-open-server (nth 1 server)) (if (nnmairix-open-server (nth 1 server))
(when (nnmairix-call-backend (when (nnmairix-call-backend
"request-list" nnmairix-backend-server) "request-list" nnmairix-backend-server)
(let (cur qualgroup folder) (let (cur qualgroup) ;; folder
(with-current-buffer nntp-server-buffer (with-current-buffer nntp-server-buffer
(goto-char (point-min)) (goto-char (point-min))
(while (re-search-forward nnmairix-group-regexp (point-max) t) (while (re-search-forward nnmairix-group-regexp (point-max) t)
@ -1172,7 +1173,7 @@ Marks propagation has to be enabled for this to work."
(error "Not in a nnmairix group")) (error "Not in a nnmairix group"))
(save-excursion (save-excursion
(let ((mid (mail-header-message-id (gnus-summary-article-header))) (let ((mid (mail-header-message-id (gnus-summary-article-header)))
groups cur) groups) ;; cur
(when mid (when mid
(setq groups (nnmairix-determine-original-group-from-registry mid)) (setq groups (nnmairix-determine-original-group-from-registry mid))
(unless (or groups (unless (or groups
@ -1299,7 +1300,7 @@ If ALL is t, return also the unopened/failed ones."
"Return list of valid back end servers for nnmairix groups." "Return list of valid back end servers for nnmairix groups."
(let ((alist gnus-opened-servers) (let ((alist gnus-opened-servers)
(mairixservers (nnmairix-get-nnmairix-servers t)) (mairixservers (nnmairix-get-nnmairix-servers t))
server mserver openedserver occ cur) server mserver openedserver occ) ;; cur
;; Get list of all nnmairix backends (i.e. backends which are ;; Get list of all nnmairix backends (i.e. backends which are
;; already occupied) ;; already occupied)
(dolist (cur mairixservers) (dolist (cur mairixservers)
@ -1393,7 +1394,7 @@ TYPE is either `nov' or `headers'."
(let ((buf (gnus-get-buffer-create " *nnmairix buffer*")) (let ((buf (gnus-get-buffer-create " *nnmairix buffer*"))
(corr (not (zerop numc))) (corr (not (zerop numc)))
(name (buffer-name nntp-server-buffer)) (name (buffer-name nntp-server-buffer))
header cur xref) cur xref) ;; header
(with-current-buffer buf (with-current-buffer buf
(erase-buffer) (erase-buffer)
(set-buffer nntp-server-buffer) (set-buffer nntp-server-buffer)
@ -1586,7 +1587,7 @@ search in raw mode."
(when (not (gnus-buffer-live-p gnus-article-buffer)) (when (not (gnus-buffer-live-p gnus-article-buffer))
(error "No article buffer available")) (error "No article buffer available"))
(let ((server (nth 1 gnus-current-select-method)) (let ((server (nth 1 gnus-current-select-method))
mid rval group allgroups) mid group allgroups) ;; rval
;; get message id ;; get message id
(with-current-buffer gnus-article-buffer (with-current-buffer gnus-article-buffer
(gnus-summary-toggle-header 1) (gnus-summary-toggle-header 1)
@ -1817,10 +1818,10 @@ MVALUES may contain values from current article."
(widget-create 'push-button (widget-create 'push-button
:notify :notify
(if mvalues (if mvalues
(lambda (&rest ignore) (lambda (&rest _ignore)
(nnmairix-widget-send-query nnmairix-widgets (nnmairix-widget-send-query nnmairix-widgets
t)) t))
(lambda (&rest ignore) (lambda (&rest _ignore)
(nnmairix-widget-send-query nnmairix-widgets (nnmairix-widget-send-query nnmairix-widgets
nil))) nil)))
"Send Query") "Send Query")
@ -1828,16 +1829,16 @@ MVALUES may contain values from current article."
(widget-create 'push-button (widget-create 'push-button
:notify :notify
(if mvalues (if mvalues
(lambda (&rest ignore) (lambda (&rest _ignore)
(nnmairix-widget-create-group nnmairix-widgets (nnmairix-widget-create-group nnmairix-widgets
t)) t))
(lambda (&rest ignore) (lambda (&rest _ignore)
(nnmairix-widget-create-group nnmairix-widgets (nnmairix-widget-create-group nnmairix-widgets
nil))) nil)))
"Create permanent group") "Create permanent group")
(widget-insert " ") (widget-insert " ")
(widget-create 'push-button (widget-create 'push-button
:notify (lambda (&rest ignore) :notify (lambda (&rest _ignore)
(kill-buffer nnmairix-customize-query-buffer)) (kill-buffer nnmairix-customize-query-buffer))
"Cancel") "Cancel")
(use-local-map widget-keymap) (use-local-map widget-keymap)
@ -1912,7 +1913,7 @@ If WITHVALUES is t, query is based on current article."
(defun nnmairix-widget-create-query (&optional values) (defun nnmairix-widget-create-query (&optional values)
"Create widgets for creating mairix queries. "Create widgets for creating mairix queries.
Fill in VALUES if based on an article." Fill in VALUES if based on an article."
(let (allwidgets) ;;(let (allwidgets)
(when (get-buffer nnmairix-customize-query-buffer) (when (get-buffer nnmairix-customize-query-buffer)
(kill-buffer nnmairix-customize-query-buffer)) (kill-buffer nnmairix-customize-query-buffer))
(switch-to-buffer nnmairix-customize-query-buffer) (switch-to-buffer nnmairix-customize-query-buffer)
@ -1943,7 +1944,7 @@ Fill in VALUES if based on an article."
(when (member 'threads nnmairix-widget-other) (when (member 'threads nnmairix-widget-other)
(widget-insert "\n") (widget-insert "\n")
(nnmairix-widget-add "Threads" 'checkbox nil)) (nnmairix-widget-add "Threads" 'checkbox nil))
(widget-insert " Show full threads\n\n"))) (widget-insert " Show full threads\n\n")) ;; )
(defun nnmairix-widget-build-editable-fields (values) (defun nnmairix-widget-build-editable-fields (values)
"Build editable field widgets in `nnmairix-widget-fields-list'. "Build editable field widgets in `nnmairix-widget-fields-list'.
@ -1960,7 +1961,7 @@ VALUES may contain values for editable fields from current article."
(concat "c" field) (concat "c" field)
(widget-create 'checkbox (widget-create 'checkbox
:tag field :tag field
:notify (lambda (widget &rest ignore) :notify (lambda (widget &rest _ignore)
(nnmairix-widget-toggle-activate widget)) (nnmairix-widget-toggle-activate widget))
nil))) nil)))
(list (list

22
lisp/gnus/nnmbox.el
View file

@ -1,4 +1,4 @@
;;; nnmbox.el --- mail mbox access for Gnus ;;; nnmbox.el --- mail mbox access for Gnus -*- lexical-binding: t; -*-
;; Copyright (C) 1995-2021 Free Software Foundation, Inc. ;; Copyright (C) 1995-2021 Free Software Foundation, Inc.
@ -76,7 +76,7 @@
(nnoo-define-basics nnmbox) (nnoo-define-basics nnmbox)
(deffoo nnmbox-retrieve-headers (sequence &optional newsgroup server fetch-old) (deffoo nnmbox-retrieve-headers (sequence &optional newsgroup server _fetch-old)
(with-current-buffer nntp-server-buffer (with-current-buffer nntp-server-buffer
(erase-buffer) (erase-buffer)
(let ((number (length sequence)) (let ((number (length sequence))
@ -168,7 +168,7 @@
(cons nnmbox-current-group article) (cons nnmbox-current-group article)
(nnmbox-article-group-number nil)))))))) (nnmbox-article-group-number nil))))))))
(deffoo nnmbox-request-group (group &optional server dont-check info) (deffoo nnmbox-request-group (group &optional server dont-check _info)
(nnmbox-possibly-change-newsgroup nil server) (nnmbox-possibly-change-newsgroup nil server)
(let ((active (cadr (assoc group nnmbox-group-alist)))) (let ((active (cadr (assoc group nnmbox-group-alist))))
(cond (cond
@ -213,10 +213,10 @@
(insert-buffer-substring in-buf))) (insert-buffer-substring in-buf)))
(nnmbox-save-active nnmbox-group-alist nnmbox-active-file)))) (nnmbox-save-active nnmbox-group-alist nnmbox-active-file))))
(deffoo nnmbox-close-group (group &optional server) (deffoo nnmbox-close-group (_group &optional _server)
t) t)
(deffoo nnmbox-request-create-group (group &optional server args) (deffoo nnmbox-request-create-group (group &optional _server _args)
(nnmail-activate 'nnmbox) (nnmail-activate 'nnmbox)
(unless (assoc group nnmbox-group-alist) (unless (assoc group nnmbox-group-alist)
(push (list group (cons 1 0)) (push (list group (cons 1 0))
@ -224,7 +224,7 @@
(nnmbox-save-active nnmbox-group-alist nnmbox-active-file)) (nnmbox-save-active nnmbox-group-alist nnmbox-active-file))
t) t)
(deffoo nnmbox-request-list (&optional server) (deffoo nnmbox-request-list (&optional _server)
(save-excursion (save-excursion
(let ((nnmail-file-coding-system (let ((nnmail-file-coding-system
nnmbox-active-file-coding-system)) nnmbox-active-file-coding-system))
@ -232,12 +232,14 @@
(setq nnmbox-group-alist (nnmail-get-active)) (setq nnmbox-group-alist (nnmail-get-active))
t)) t))
(deffoo nnmbox-request-newgroups (date &optional server) (deffoo nnmbox-request-newgroups (_date &optional server)
(nnmbox-request-list server)) (nnmbox-request-list server))
(deffoo nnmbox-request-list-newsgroups (&optional server) (deffoo nnmbox-request-list-newsgroups (&optional _server)
(nnheader-report 'nnmbox "LIST NEWSGROUPS is not implemented.")) (nnheader-report 'nnmbox "LIST NEWSGROUPS is not implemented."))
(defvar nnml-current-directory)
(deffoo nnmbox-request-expire-articles (deffoo nnmbox-request-expire-articles
(articles newsgroup &optional server force) (articles newsgroup &optional server force)
(nnmbox-possibly-change-newsgroup newsgroup server) (nnmbox-possibly-change-newsgroup newsgroup server)
@ -278,7 +280,7 @@
(nconc rest articles)))) (nconc rest articles))))
(deffoo nnmbox-request-move-article (deffoo nnmbox-request-move-article
(article group server accept-form &optional last move-is-internal) (article group server accept-form &optional last _move-is-internal)
(let ((buf (gnus-get-buffer-create " *nnmbox move*")) (let ((buf (gnus-get-buffer-create " *nnmbox move*"))
result) result)
(and (and
@ -291,7 +293,7 @@
"^X-Gnus-Newsgroup:" "^X-Gnus-Newsgroup:"
(save-excursion (search-forward "\n\n" nil t) (point)) t) (save-excursion (search-forward "\n\n" nil t) (point)) t)
(gnus-delete-line)) (gnus-delete-line))
(setq result (eval accept-form)) (setq result (eval accept-form t))
(kill-buffer buf) (kill-buffer buf)
result) result)
(save-excursion (save-excursion

25
lisp/gnus/nnmh.el
View file

@ -1,4 +1,4 @@
;;; nnmh.el --- mhspool access for Gnus ;;; nnmh.el --- mhspool access for Gnus -*- lexical-binding: t; -*-
;; Copyright (C) 1995-2021 Free Software Foundation, Inc. ;; Copyright (C) 1995-2021 Free Software Foundation, Inc.
@ -72,7 +72,7 @@ as unread by Gnus.")
(nnoo-define-basics nnmh) (nnoo-define-basics nnmh)
(deffoo nnmh-retrieve-headers (articles &optional newsgroup server fetch-old) (deffoo nnmh-retrieve-headers (articles &optional newsgroup server _fetch-old)
(with-current-buffer nntp-server-buffer (with-current-buffer nntp-server-buffer
(erase-buffer) (erase-buffer)
(let* ((file nil) (let* ((file nil)
@ -147,7 +147,7 @@ as unread by Gnus.")
(save-excursion (nnmail-find-file file)) (save-excursion (nnmail-find-file file))
(string-to-number (file-name-nondirectory file))))) (string-to-number (file-name-nondirectory file)))))
(deffoo nnmh-request-group (group &optional server dont-check info) (deffoo nnmh-request-group (group &optional server dont-check _info)
(nnheader-init-server-buffer) (nnheader-init-server-buffer)
(nnmh-possibly-change-directory group server) (nnmh-possibly-change-directory group server)
(let ((pathname (nnmail-group-pathname group nnmh-directory)) (let ((pathname (nnmail-group-pathname group nnmh-directory))
@ -188,9 +188,11 @@ as unread by Gnus.")
(nnheader-report 'nnmh "Empty group %s" group) (nnheader-report 'nnmh "Empty group %s" group)
(nnheader-insert (format "211 0 1 0 %s\n" group)))))))))) (nnheader-insert (format "211 0 1 0 %s\n" group))))))))))
(deffoo nnmh-request-scan (&optional group server) (deffoo nnmh-request-scan (&optional group _server)
(nnmail-get-new-mail 'nnmh nil nnmh-directory group)) (nnmail-get-new-mail 'nnmh nil nnmh-directory group))
(defvar nnmh-toplev)
(deffoo nnmh-request-list (&optional server dir) (deffoo nnmh-request-list (&optional server dir)
(nnheader-insert "") (nnheader-insert "")
(nnmh-possibly-change-directory nil server) (nnmh-possibly-change-directory nil server)
@ -201,13 +203,12 @@ as unread by Gnus.")
(setq nnmh-group-alist (nnmail-get-active)) (setq nnmh-group-alist (nnmail-get-active))
t) t)
(defvar nnmh-toplev)
(defun nnmh-request-list-1 (dir) (defun nnmh-request-list-1 (dir)
(setq dir (expand-file-name dir)) (setq dir (expand-file-name dir))
;; Recurse down all directories. ;; Recurse down all directories.
(let ((files (nnheader-directory-files dir t nil t)) (let ((files (nnheader-directory-files dir t nil t))
(max 0) (max 0)
min rdir num subdirectoriesp file) min num subdirectoriesp file) ;; rdir
;; Recurse down directories. ;; Recurse down directories.
(setq subdirectoriesp (setq subdirectoriesp
;; link number always 1 on MS Windows :( ;; link number always 1 on MS Windows :(
@ -252,7 +253,7 @@ as unread by Gnus.")
(or min 1)))))) (or min 1))))))
t) t)
(deffoo nnmh-request-newgroups (date &optional server) (deffoo nnmh-request-newgroups (_date &optional server)
(nnmh-request-list server)) (nnmh-request-list server))
(deffoo nnmh-request-expire-articles (articles newsgroup (deffoo nnmh-request-expire-articles (articles newsgroup
@ -291,11 +292,11 @@ as unread by Gnus.")
(nnheader-message 5 "") (nnheader-message 5 "")
(nconc rest articles))) (nconc rest articles)))
(deffoo nnmh-close-group (group &optional server) (deffoo nnmh-close-group (_group &optional _server)
t) t)
(deffoo nnmh-request-move-article (article group server accept-form (deffoo nnmh-request-move-article ( article group server accept-form
&optional last move-is-internal) &optional _last _move-is-internal)
(let ((buf (gnus-get-buffer-create " *nnmh move*")) (let ((buf (gnus-get-buffer-create " *nnmh move*"))
result) result)
(and (and
@ -304,7 +305,7 @@ as unread by Gnus.")
(with-current-buffer buf (with-current-buffer buf
(erase-buffer) (erase-buffer)
(insert-buffer-substring nntp-server-buffer) (insert-buffer-substring nntp-server-buffer)
(setq result (eval accept-form)) (setq result (eval accept-form t))
(kill-buffer (current-buffer)) (kill-buffer (current-buffer))
result) result)
(progn (progn
@ -350,7 +351,7 @@ as unread by Gnus.")
nil (if (nnheader-be-verbose 5) nil 'nomesg)) nil (if (nnheader-be-verbose 5) nil 'nomesg))
t))) t)))
(deffoo nnmh-request-create-group (group &optional server args) (deffoo nnmh-request-create-group (group &optional server _args)
(nnheader-init-server-buffer) (nnheader-init-server-buffer)
(unless (assoc group nnmh-group-alist) (unless (assoc group nnmh-group-alist)
(let (active) (let (active)

22
lisp/gnus/nnml.el
View file

@ -1,4 +1,4 @@
;;; nnml.el --- mail spool access for Gnus ;;; nnml.el --- mail spool access for Gnus -*- lexical-binding: t; -*-
;; Copyright (C) 1995-2021 Free Software Foundation, Inc. ;; Copyright (C) 1995-2021 Free Software Foundation, Inc.
@ -111,7 +111,7 @@ non-nil.")
(nnoo-define-basics nnml) (nnoo-define-basics nnml)
(defun nnml-group-pathname (group &optional file server) (defun nnml-group-pathname (group &optional file _server)
"Return an absolute file name of FILE for GROUP on SERVER." "Return an absolute file name of FILE for GROUP on SERVER."
(nnmail-group-pathname group nnml-directory file)) (nnmail-group-pathname group nnml-directory file))
@ -215,7 +215,7 @@ non-nil.")
(cons (if group-num (car group-num) group) (cons (if group-num (car group-num) group)
(string-to-number (file-name-nondirectory path))))))) (string-to-number (file-name-nondirectory path)))))))
(deffoo nnml-request-group (group &optional server dont-check info) (deffoo nnml-request-group (group &optional server dont-check _info)
(let ((file-name-coding-system nnmail-pathname-coding-system)) (let ((file-name-coding-system nnmail-pathname-coding-system))
(cond (cond
((not (nnml-possibly-change-directory group server)) ((not (nnml-possibly-change-directory group server))
@ -252,11 +252,11 @@ non-nil.")
(t (t
(nnmail-get-new-mail 'nnml 'nnml-save-incremental-nov nnml-directory nil)))) (nnmail-get-new-mail 'nnml 'nnml-save-incremental-nov nnml-directory nil))))
(deffoo nnml-close-group (group &optional server) (deffoo nnml-close-group (_group &optional _server)
(setq nnml-article-file-alist nil) (setq nnml-article-file-alist nil)
t) t)
(deffoo nnml-request-create-group (group &optional server args) (deffoo nnml-request-create-group (group &optional server _args)
(nnml-possibly-change-directory nil server) (nnml-possibly-change-directory nil server)
(nnmail-activate 'nnml) (nnmail-activate 'nnml)
(cond (cond
@ -283,7 +283,7 @@ non-nil.")
(nnmail-save-active nnml-group-alist nnml-active-file) (nnmail-save-active nnml-group-alist nnml-active-file)
t)))) t))))
(deffoo nnml-request-list (&optional server) (deffoo nnml-request-list (&optional _server)
(save-excursion (save-excursion
(let ((nnmail-file-coding-system nnmail-active-file-coding-system) (let ((nnmail-file-coding-system nnmail-active-file-coding-system)
(file-name-coding-system nnmail-pathname-coding-system)) (file-name-coding-system nnmail-pathname-coding-system))
@ -291,10 +291,10 @@ non-nil.")
(setq nnml-group-alist (nnmail-get-active)) (setq nnml-group-alist (nnmail-get-active))
t)) t))
(deffoo nnml-request-newgroups (date &optional server) (deffoo nnml-request-newgroups (_date &optional server)
(nnml-request-list server)) (nnml-request-list server))
(deffoo nnml-request-list-newsgroups (&optional server) (deffoo nnml-request-list-newsgroups (&optional _server)
(save-excursion (save-excursion
(nnmail-find-file nnml-newsgroups-file))) (nnmail-find-file nnml-newsgroups-file)))
@ -360,7 +360,7 @@ non-nil.")
(nconc rest articles))) (nconc rest articles)))
(deffoo nnml-request-move-article (deffoo nnml-request-move-article
(article group server accept-form &optional last move-is-internal) (article group server accept-form &optional last _move-is-internal)
(let ((buf (gnus-get-buffer-create " *nnml move*")) (let ((buf (gnus-get-buffer-create " *nnml move*"))
(file-name-coding-system nnmail-pathname-coding-system) (file-name-coding-system nnmail-pathname-coding-system)
result) result)
@ -374,7 +374,7 @@ non-nil.")
nnml-article-file-alist) nnml-article-file-alist)
(with-current-buffer buf (with-current-buffer buf
(insert-buffer-substring nntp-server-buffer) (insert-buffer-substring nntp-server-buffer)
(setq result (eval accept-form)) (setq result (eval accept-form t))
(kill-buffer (current-buffer)) (kill-buffer (current-buffer))
result)) result))
(progn (progn
@ -889,7 +889,7 @@ Unless no-active is non-nil, update the active file too."
(let* ((dir (file-name-as-directory dir)) (let* ((dir (file-name-as-directory dir))
(nov (concat dir nnml-nov-file-name)) (nov (concat dir nnml-nov-file-name))
(nov-buffer (gnus-get-buffer-create " *nov*")) (nov-buffer (gnus-get-buffer-create " *nov*"))
chars file headers) chars headers) ;; file
(with-current-buffer nov-buffer (with-current-buffer nov-buffer
;; Init the nov buffer. ;; Init the nov buffer.
(buffer-disable-undo) (buffer-disable-undo)

22
lisp/gnus/nnnil.el
View file

@ -1,4 +1,4 @@
;;; nnnil.el --- empty backend for Gnus ;;; nnnil.el --- empty backend for Gnus -*- lexical-binding: t; -*-
;; This file is in the public domain. ;; This file is in the public domain.
@ -32,31 +32,31 @@
(defvar nnnil-status-string "") (defvar nnnil-status-string "")
(defun nnnil-retrieve-headers (articles &optional group server fetch-old) (defun nnnil-retrieve-headers (_articles &optional _group _server _fetch-old)
(with-current-buffer nntp-server-buffer (with-current-buffer nntp-server-buffer
(erase-buffer)) (erase-buffer))
'nov) 'nov)
(defun nnnil-open-server (server &optional definitions) (defun nnnil-open-server (_server &optional _definitions)
t) t)
(defun nnnil-close-server (&optional server) (defun nnnil-close-server (&optional _server)
t) t)
(defun nnnil-request-close () (defun nnnil-request-close ()
t) t)
(defun nnnil-server-opened (&optional server) (defun nnnil-server-opened (&optional _server)
t) t)
(defun nnnil-status-message (&optional server) (defun nnnil-status-message (&optional _server)
nnnil-status-string) nnnil-status-string)
(defun nnnil-request-article (article &optional group server to-buffer) (defun nnnil-request-article (_article &optional _group _server _to-buffer)
(setq nnnil-status-string "No such group") (setq nnnil-status-string "No such group")
nil) nil)
(defun nnnil-request-group (group &optional server fast info) (defun nnnil-request-group (_group &optional _server _fast _info)
(let (deactivate-mark) (let (deactivate-mark)
(with-current-buffer nntp-server-buffer (with-current-buffer nntp-server-buffer
(erase-buffer) (erase-buffer)
@ -64,15 +64,15 @@
(setq nnnil-status-string "No such group") (setq nnnil-status-string "No such group")
nil) nil)
(defun nnnil-close-group (group &optional server) (defun nnnil-close-group (_group &optional _server)
t) t)
(defun nnnil-request-list (&optional server) (defun nnnil-request-list (&optional _server)
(with-current-buffer nntp-server-buffer (with-current-buffer nntp-server-buffer
(erase-buffer)) (erase-buffer))
t) t)
(defun nnnil-request-post (&optional server) (defun nnnil-request-post (&optional _server)
(setq nnnil-status-string "Read-only server") (setq nnnil-status-string "Read-only server")
nil) nil)

4
lisp/gnus/nnoo.el
View file

@ -1,4 +1,4 @@
;;; nnoo.el --- OO Gnus Backends ;;; nnoo.el --- OO Gnus Backends -*- lexical-binding: t; -*-
;; Copyright (C) 1996-2021 Free Software Foundation, Inc. ;; Copyright (C) 1996-2021 Free Software Foundation, Inc.
@ -257,7 +257,7 @@
nnoo-state-alist)) nnoo-state-alist))
t) t)
(defun nnoo-status-message (backend server) (defun nnoo-status-message (backend _server)
(nnheader-get-report backend)) (nnheader-get-report backend))
(defun nnoo-server-opened (backend server) (defun nnoo-server-opened (backend server)

13
lisp/gnus/nnregistry.el
View file

@ -1,5 +1,4 @@
;;; nnregistry.el --- access to articles via Gnus' message-id registry ;;; nnregistry.el --- access to articles via Gnus' message-id registry -*- lexical-binding: t; -*-
;;; -*- coding: utf-8 -*-
;; Copyright (C) 2010-2021 Free Software Foundation, Inc. ;; Copyright (C) 2010-2021 Free Software Foundation, Inc.
@ -36,21 +35,21 @@
(nnoo-declare nnregistry) (nnoo-declare nnregistry)
(deffoo nnregistry-server-opened (server) (deffoo nnregistry-server-opened (_server)
gnus-registry-enabled) gnus-registry-enabled)
(deffoo nnregistry-close-server (server &optional defs) (deffoo nnregistry-close-server (_server &optional _defs)
t) t)
(deffoo nnregistry-status-message (server) (deffoo nnregistry-status-message (_server)
nil) nil)
(deffoo nnregistry-open-server (server &optional defs) (deffoo nnregistry-open-server (_server &optional _defs)
gnus-registry-enabled) gnus-registry-enabled)
(defvar nnregistry-within-nnregistry nil) (defvar nnregistry-within-nnregistry nil)
(deffoo nnregistry-request-article (id &optional group server buffer) (deffoo nnregistry-request-article (id &optional _group _server buffer)
(and (not nnregistry-within-nnregistry) (and (not nnregistry-within-nnregistry)
(let* ((nnregistry-within-nnregistry t) (let* ((nnregistry-within-nnregistry t)
(group (nth 0 (gnus-registry-get-id-key id 'group))) (group (nth 0 (gnus-registry-get-id-key id 'group)))

22
lisp/gnus/nnrss.el
View file

@ -1,4 +1,4 @@
;;; nnrss.el --- interfacing with RSS ;;; nnrss.el --- interfacing with RSS -*- lexical-binding: t; -*-
;; Copyright (C) 2001-2021 Free Software Foundation, Inc. ;; Copyright (C) 2001-2021 Free Software Foundation, Inc.
@ -125,7 +125,7 @@ for decoding when the cdr that the data specify is not available.")
(setq group (decode-coding-string group 'utf-8)) (setq group (decode-coding-string group 'utf-8))
group)) group))
(deffoo nnrss-retrieve-headers (articles &optional group server fetch-old) (deffoo nnrss-retrieve-headers (articles &optional group server _fetch-old)
(setq group (nnrss-decode-group-name group)) (setq group (nnrss-decode-group-name group))
(nnrss-possibly-change-group group server) (nnrss-possibly-change-group group server)
(let (e) (let (e)
@ -173,7 +173,7 @@ for decoding when the cdr that the data specify is not available.")
"\n"))))) "\n")))))
'nov) 'nov)
(deffoo nnrss-request-group (group &optional server dont-check info) (deffoo nnrss-request-group (group &optional server dont-check _info)
(setq group (nnrss-decode-group-name group)) (setq group (nnrss-decode-group-name group))
(nnheader-message 6 "nnrss: Requesting %s..." group) (nnheader-message 6 "nnrss: Requesting %s..." group)
(nnrss-possibly-change-group group server) (nnrss-possibly-change-group group server)
@ -188,7 +188,7 @@ for decoding when the cdr that the data specify is not available.")
t)) t))
(nnheader-message 6 "nnrss: Requesting %s...done" group))) (nnheader-message 6 "nnrss: Requesting %s...done" group)))
(deffoo nnrss-close-group (group &optional server) (deffoo nnrss-close-group (_group &optional _server)
t) t)
(deffoo nnrss-request-article (article &optional group server buffer) (deffoo nnrss-request-article (article &optional group server buffer)
@ -200,7 +200,7 @@ for decoding when the cdr that the data specify is not available.")
(nnrss-possibly-change-group group server) (nnrss-possibly-change-group group server)
(let ((e (assq article nnrss-group-data)) (let ((e (assq article nnrss-group-data))
(nntp-server-buffer (or buffer nntp-server-buffer)) (nntp-server-buffer (or buffer nntp-server-buffer))
post err) err) ;; post
(when e (when e
(with-current-buffer nntp-server-buffer (with-current-buffer nntp-server-buffer
(erase-buffer) (erase-buffer)
@ -222,7 +222,7 @@ for decoding when the cdr that the data specify is not available.")
(cons '("Newsgroups" . utf-8) (cons '("Newsgroups" . utf-8)
rfc2047-header-encoding-alist) rfc2047-header-encoding-alist)
rfc2047-header-encoding-alist)) rfc2047-header-encoding-alist))
rfc2047-encode-encoded-words body fn) rfc2047-encode-encoded-words body) ;; fn
(when (or text link enclosure comments) (when (or text link enclosure comments)
(insert "\n") (insert "\n")
(insert "<#multipart type=alternative>\n" (insert "<#multipart type=alternative>\n"
@ -311,7 +311,7 @@ for decoding when the cdr that the data specify is not available.")
;; we return the article number. ;; we return the article number.
(cons nnrss-group (car e)))))) (cons nnrss-group (car e))))))
(deffoo nnrss-open-server (server &optional defs connectionless) (deffoo nnrss-open-server (server &optional defs _connectionless)
(nnrss-read-server-data server) (nnrss-read-server-data server)
(nnoo-change-server 'nnrss server defs) (nnoo-change-server 'nnrss server defs)
t) t)
@ -335,7 +335,7 @@ for decoding when the cdr that the data specify is not available.")
(nnrss-save-group-data group server)) (nnrss-save-group-data group server))
not-expirable)) not-expirable))
(deffoo nnrss-request-delete-group (group &optional force server) (deffoo nnrss-request-delete-group (group &optional _force server)
(setq group (nnrss-decode-group-name group)) (setq group (nnrss-decode-group-name group))
(nnrss-possibly-change-group group server) (nnrss-possibly-change-group group server)
(let (elem) (let (elem)
@ -561,7 +561,7 @@ which RSS 2.0 allows."
;;; URL interface ;;; URL interface
(defun nnrss-no-cache (url) (defun nnrss-no-cache (_url)
"") "")
(defun nnrss-insert (url) (defun nnrss-insert (url)
@ -613,7 +613,7 @@ which RSS 2.0 allows."
(defun nnrss-check-group (group server) (defun nnrss-check-group (group server)
(let (file xml subject url extra changed author date feed-subject (let (file xml subject url extra changed author date feed-subject
enclosure comments rss-ns rdf-ns content-ns dc-ns enclosure comments rss-ns content-ns dc-ns ;; rdf-ns
hash-index) hash-index)
(if (and nnrss-use-local (if (and nnrss-use-local
(file-exists-p (setq file (expand-file-name (file-exists-p (setq file (expand-file-name
@ -637,7 +637,7 @@ which RSS 2.0 allows."
(setq changed t)) (setq changed t))
(setq xml (nnrss-fetch url))) (setq xml (nnrss-fetch url)))
(setq dc-ns (nnrss-get-namespace-prefix xml "http://purl.org/dc/elements/1.1/") (setq dc-ns (nnrss-get-namespace-prefix xml "http://purl.org/dc/elements/1.1/")
rdf-ns (nnrss-get-namespace-prefix xml "http://www.w3.org/1999/02/22-rdf-syntax-ns#") ;; rdf-ns (nnrss-get-namespace-prefix xml "http://www.w3.org/1999/02/22-rdf-syntax-ns#")
rss-ns (nnrss-get-namespace-prefix xml "http://purl.org/rss/1.0/") rss-ns (nnrss-get-namespace-prefix xml "http://purl.org/rss/1.0/")
content-ns (nnrss-get-namespace-prefix xml "http://purl.org/rss/1.0/modules/content/")) content-ns (nnrss-get-namespace-prefix xml "http://purl.org/rss/1.0/modules/content/"))
(dolist (item (nreverse (nnrss-find-el (intern (concat rss-ns "item")) xml))) (dolist (item (nreverse (nnrss-find-el (intern (concat rss-ns "item")) xml)))

28
lisp/gnus/nnspool.el
View file

@ -1,4 +1,4 @@
;;; nnspool.el --- spool access for GNU Emacs ;;; nnspool.el --- spool access for GNU Emacs -*- lexical-binding: t; -*-
;; Copyright (C) 1988-1990, 1993-1998, 2000-2021 Free Software ;; Copyright (C) 1988-1990, 1993-1998, 2000-2021 Free Software
;; Foundation, Inc. ;; Foundation, Inc.
@ -126,7 +126,7 @@ there.")
(nnoo-define-basics nnspool) (nnoo-define-basics nnspool)
(deffoo nnspool-retrieve-headers (articles &optional group server fetch-old) (deffoo nnspool-retrieve-headers (articles &optional group _server fetch-old)
"Retrieve the headers of ARTICLES." "Retrieve the headers of ARTICLES."
(with-current-buffer nntp-server-buffer (with-current-buffer nntp-server-buffer
(erase-buffer) (erase-buffer)
@ -203,7 +203,7 @@ there.")
server nnspool-spool-directory) server nnspool-spool-directory)
t))) t)))
(deffoo nnspool-request-article (id &optional group server buffer) (deffoo nnspool-request-article (id &optional group _server buffer)
"Select article by message ID (or number)." "Select article by message ID (or number)."
(nnspool-possibly-change-directory group) (nnspool-possibly-change-directory group)
(let ((nntp-server-buffer (or buffer nntp-server-buffer)) (let ((nntp-server-buffer (or buffer nntp-server-buffer))
@ -222,7 +222,7 @@ there.")
(cons nnspool-current-group id) (cons nnspool-current-group id)
ag)))) ag))))
(deffoo nnspool-request-body (id &optional group server) (deffoo nnspool-request-body (id &optional group _server)
"Select article body by message ID (or number)." "Select article body by message ID (or number)."
(nnspool-possibly-change-directory group) (nnspool-possibly-change-directory group)
(let ((res (nnspool-request-article id))) (let ((res (nnspool-request-article id)))
@ -233,7 +233,7 @@ there.")
(delete-region (point-min) (point))) (delete-region (point-min) (point)))
res)))) res))))
(deffoo nnspool-request-head (id &optional group server) (deffoo nnspool-request-head (id &optional group _server)
"Select article head by message ID (or number)." "Select article head by message ID (or number)."
(nnspool-possibly-change-directory group) (nnspool-possibly-change-directory group)
(let ((res (nnspool-request-article id))) (let ((res (nnspool-request-article id)))
@ -245,7 +245,7 @@ there.")
(nnheader-fold-continuation-lines))) (nnheader-fold-continuation-lines)))
res)) res))
(deffoo nnspool-request-group (group &optional server dont-check info) (deffoo nnspool-request-group (group &optional _server dont-check _info)
"Select news GROUP." "Select news GROUP."
(let ((pathname (nnspool-article-pathname group)) (let ((pathname (nnspool-article-pathname group))
dir) dir)
@ -269,26 +269,26 @@ there.")
(nnheader-report 'nnspool "Empty group %s" group) (nnheader-report 'nnspool "Empty group %s" group)
(nnheader-insert "211 0 0 0 %s\n" group)))))) (nnheader-insert "211 0 0 0 %s\n" group))))))
(deffoo nnspool-request-type (group &optional article) (deffoo nnspool-request-type (_group &optional _article)
'news) 'news)
(deffoo nnspool-close-group (group &optional server) (deffoo nnspool-close-group (_group &optional _server)
t) t)
(deffoo nnspool-request-list (&optional server) (deffoo nnspool-request-list (&optional _server)
"List active newsgroups." "List active newsgroups."
(save-excursion (save-excursion
(or (nnspool-find-file nnspool-active-file) (or (nnspool-find-file nnspool-active-file)
(nnheader-report 'nnspool (nnheader-file-error nnspool-active-file))))) (nnheader-report 'nnspool (nnheader-file-error nnspool-active-file)))))
(deffoo nnspool-request-list-newsgroups (&optional server) (deffoo nnspool-request-list-newsgroups (&optional _server)
"List newsgroups (defined in NNTP2)." "List newsgroups (defined in NNTP2)."
(save-excursion (save-excursion
(or (nnspool-find-file nnspool-newsgroups-file) (or (nnspool-find-file nnspool-newsgroups-file)
(nnheader-report 'nnspool (nnheader-file-error (nnheader-report 'nnspool (nnheader-file-error
nnspool-newsgroups-file))))) nnspool-newsgroups-file)))))
(deffoo nnspool-request-list-distributions (&optional server) (deffoo nnspool-request-list-distributions (&optional _server)
"List distributions (defined in NNTP2)." "List distributions (defined in NNTP2)."
(save-excursion (save-excursion
(or (nnspool-find-file nnspool-distributions-file) (or (nnspool-find-file nnspool-distributions-file)
@ -296,7 +296,7 @@ there.")
nnspool-distributions-file))))) nnspool-distributions-file)))))
;; Suggested by Hallvard B Furuseth <h.b.furuseth@usit.uio.no>. ;; Suggested by Hallvard B Furuseth <h.b.furuseth@usit.uio.no>.
(deffoo nnspool-request-newgroups (date &optional server) (deffoo nnspool-request-newgroups (date &optional _server)
"List groups created after DATE." "List groups created after DATE."
(if (nnspool-find-file nnspool-active-times-file) (if (nnspool-find-file nnspool-active-times-file)
(save-excursion (save-excursion
@ -323,7 +323,7 @@ there.")
t) t)
nil)) nil))
(deffoo nnspool-request-post (&optional server) (deffoo nnspool-request-post (&optional _server)
"Post a new news in current buffer." "Post a new news in current buffer."
(save-excursion (save-excursion
(let* ((process-connection-type nil) ; t bugs out on Solaris (let* ((process-connection-type nil) ; t bugs out on Solaris
@ -356,7 +356,7 @@ there.")
;;; Internal functions. ;;; Internal functions.
(defun nnspool-inews-sentinel (proc status) (defun nnspool-inews-sentinel (proc _status)
(with-current-buffer (process-buffer proc) (with-current-buffer (process-buffer proc)
(goto-char (point-min)) (goto-char (point-min))
(if (or (zerop (buffer-size)) (if (or (zerop (buffer-size))

2
lisp/gnus/nntp.el
View file

@ -1330,7 +1330,7 @@ If SEND-IF-FORCE, only send authinfo to the server if the
(dolist (entry nntp-server-action-alist) (dolist (entry nntp-server-action-alist)
(when (string-match (car entry) nntp-server-type) (when (string-match (car entry) nntp-server-type)
(if (not (functionp (cadr entry))) (if (not (functionp (cadr entry)))
(eval (cadr entry)) (eval (cadr entry) t)
(funcall (cadr entry))))))) (funcall (cadr entry)))))))
(defun nntp-async-wait (process wait-for buffer decode callback) (defun nntp-async-wait (process wait-for buffer decode callback)

32
lisp/gnus/nnvirtual.el
View file

@ -1,4 +1,4 @@
;;; nnvirtual.el --- virtual newsgroups access for Gnus ;;; nnvirtual.el --- virtual newsgroups access for Gnus -*- lexical-binding: t; -*-
;; Copyright (C) 1994-2021 Free Software Foundation, Inc. ;; Copyright (C) 1994-2021 Free Software Foundation, Inc.
@ -94,8 +94,8 @@ It is computed from the marks of individual component groups.")
(nnoo-define-basics nnvirtual) (nnoo-define-basics nnvirtual)
(deffoo nnvirtual-retrieve-headers (articles &optional newsgroup (deffoo nnvirtual-retrieve-headers (articles &optional _newsgroup
server fetch-old) server _fetch-old)
(when (nnvirtual-possibly-change-server server) (when (nnvirtual-possibly-change-server server)
(with-current-buffer nntp-server-buffer (with-current-buffer nntp-server-buffer
(erase-buffer) (erase-buffer)
@ -186,7 +186,7 @@ It is computed from the marks of individual component groups.")
(defvoo nnvirtual-last-accessed-component-group nil) (defvoo nnvirtual-last-accessed-component-group nil)
(deffoo nnvirtual-request-article (article &optional group server buffer) (deffoo nnvirtual-request-article (article &optional _group server buffer)
(when (nnvirtual-possibly-change-server server) (when (nnvirtual-possibly-change-server server)
(if (stringp article) (if (stringp article)
;; This is a fetch by Message-ID. ;; This is a fetch by Message-ID.
@ -250,7 +250,7 @@ It is computed from the marks of individual component groups.")
t))) t)))
(deffoo nnvirtual-request-group (group &optional server dont-check info) (deffoo nnvirtual-request-group (group &optional server dont-check _info)
(nnvirtual-possibly-change-server server) (nnvirtual-possibly-change-server server)
(setq nnvirtual-component-groups (setq nnvirtual-component-groups
(delete (nnvirtual-current-group) nnvirtual-component-groups)) (delete (nnvirtual-current-group) nnvirtual-component-groups))
@ -269,7 +269,7 @@ It is computed from the marks of individual component groups.")
nnvirtual-mapping-len nnvirtual-mapping-len group)))) nnvirtual-mapping-len nnvirtual-mapping-len group))))
(deffoo nnvirtual-request-type (group &optional article) (deffoo nnvirtual-request-type (_group &optional article)
(if (not article) (if (not article)
'unknown 'unknown
(if (numberp article) (if (numberp article)
@ -279,7 +279,7 @@ It is computed from the marks of individual component groups.")
(gnus-request-type (gnus-request-type
nnvirtual-last-accessed-component-group nil)))) nnvirtual-last-accessed-component-group nil))))
(deffoo nnvirtual-request-update-mark (group article mark) (deffoo nnvirtual-request-update-mark (_group article mark)
(let* ((nart (nnvirtual-map-article article)) (let* ((nart (nnvirtual-map-article article))
(cgroup (car nart))) (cgroup (car nart)))
(when (and nart (when (and nart
@ -291,22 +291,22 @@ It is computed from the marks of individual component groups.")
mark) mark)
(deffoo nnvirtual-close-group (group &optional server) (deffoo nnvirtual-close-group (_group &optional server)
(when (and (nnvirtual-possibly-change-server server) (when (and (nnvirtual-possibly-change-server server)
(not (gnus-ephemeral-group-p (nnvirtual-current-group)))) (not (gnus-ephemeral-group-p (nnvirtual-current-group))))
(nnvirtual-update-read-and-marked t t)) (nnvirtual-update-read-and-marked t t))
t) t)
(deffoo nnvirtual-request-newgroups (date &optional server) (deffoo nnvirtual-request-newgroups (_date &optional _server)
(nnheader-report 'nnvirtual "NEWGROUPS is not supported.")) (nnheader-report 'nnvirtual "NEWGROUPS is not supported."))
(deffoo nnvirtual-request-list-newsgroups (&optional server) (deffoo nnvirtual-request-list-newsgroups (&optional _server)
(nnheader-report 'nnvirtual "LIST NEWSGROUPS is not implemented.")) (nnheader-report 'nnvirtual "LIST NEWSGROUPS is not implemented."))
(deffoo nnvirtual-request-update-info (group info &optional server) (deffoo nnvirtual-request-update-info (_group info &optional server)
(when (and (nnvirtual-possibly-change-server server) (when (and (nnvirtual-possibly-change-server server)
(not nnvirtual-info-installed)) (not nnvirtual-info-installed))
;; Install the precomputed lists atomically, so the virtual group ;; Install the precomputed lists atomically, so the virtual group
@ -321,7 +321,7 @@ It is computed from the marks of individual component groups.")
t)) t))
(deffoo nnvirtual-catchup-group (group &optional server all) (deffoo nnvirtual-catchup-group (_group &optional server all)
(when (and (nnvirtual-possibly-change-server server) (when (and (nnvirtual-possibly-change-server server)
(not (gnus-ephemeral-group-p (nnvirtual-current-group)))) (not (gnus-ephemeral-group-p (nnvirtual-current-group))))
;; copy over existing marks first, in case they set anything ;; copy over existing marks first, in case they set anything
@ -339,12 +339,12 @@ It is computed from the marks of individual component groups.")
(gnus-group-catchup-current nil all))))) (gnus-group-catchup-current nil all)))))
(deffoo nnvirtual-find-group-art (group article) (deffoo nnvirtual-find-group-art (_group article)
"Return the real group and article for virtual GROUP and ARTICLE." "Return the real group and article for virtual GROUP and ARTICLE."
(nnvirtual-map-article article)) (nnvirtual-map-article article))
(deffoo nnvirtual-request-post (&optional server) (deffoo nnvirtual-request-post (&optional _server)
(if (not gnus-message-group-art) (if (not gnus-message-group-art)
(nnheader-report 'nnvirtual "Can't post to an nnvirtual group") (nnheader-report 'nnvirtual "Can't post to an nnvirtual group")
(let ((group (car (nnvirtual-find-group-art (let ((group (car (nnvirtual-find-group-art
@ -353,8 +353,8 @@ It is computed from the marks of individual component groups.")
(gnus-request-post (gnus-find-method-for-group group))))) (gnus-request-post (gnus-find-method-for-group group)))))
(deffoo nnvirtual-request-expire-articles (articles group (deffoo nnvirtual-request-expire-articles ( _articles _group
&optional server force) &optional server _force)
(nnvirtual-possibly-change-server server) (nnvirtual-possibly-change-server server)
(setq nnvirtual-component-groups (setq nnvirtual-component-groups
(delete (nnvirtual-current-group) nnvirtual-component-groups)) (delete (nnvirtual-current-group) nnvirtual-component-groups))

16
lisp/gnus/nnweb.el
View file

@ -1,4 +1,4 @@
;;; nnweb.el --- retrieving articles via web search engines ;;; nnweb.el --- retrieving articles via web search engines -*- lexical-binding: t; -*-
;; Copyright (C) 1996-2021 Free Software Foundation, Inc. ;; Copyright (C) 1996-2021 Free Software Foundation, Inc.
@ -96,7 +96,7 @@ Valid types include `google', `dejanews', and `gmane'.")
(nnoo-define-basics nnweb) (nnoo-define-basics nnweb)
(deffoo nnweb-retrieve-headers (articles &optional group server fetch-old) (deffoo nnweb-retrieve-headers (articles &optional group server _fetch-old)
(nnweb-possibly-change-server group server) (nnweb-possibly-change-server group server)
(with-current-buffer nntp-server-buffer (with-current-buffer nntp-server-buffer
(erase-buffer) (erase-buffer)
@ -117,7 +117,7 @@ Valid types include `google', `dejanews', and `gmane'.")
(nnweb-write-active) (nnweb-write-active)
(nnweb-write-overview group))) (nnweb-write-overview group)))
(deffoo nnweb-request-group (group &optional server dont-check info) (deffoo nnweb-request-group (group &optional server dont-check _info)
(nnweb-possibly-change-server group server) (nnweb-possibly-change-server group server)
(unless (or nnweb-ephemeral-p (unless (or nnweb-ephemeral-p
dont-check dont-check
@ -156,7 +156,7 @@ Valid types include `google', `dejanews', and `gmane'.")
(let ((fetch (nnweb-definition 'id)) (let ((fetch (nnweb-definition 'id))
(art (when (string-match "^<\\(.*\\)>$" article) (art (when (string-match "^<\\(.*\\)>$" article)
(match-string 1 article))) (match-string 1 article)))
active) ) ;; active
(when (and fetch art) (when (and fetch art)
(setq url (format fetch (setq url (format fetch
(mm-url-form-encode-xwfu art))) (mm-url-form-encode-xwfu art)))
@ -184,19 +184,19 @@ Valid types include `google', `dejanews', and `gmane'.")
(nnmail-generate-active (list (assoc server nnweb-group-alist))) (nnmail-generate-active (list (assoc server nnweb-group-alist)))
t)) t))
(deffoo nnweb-request-update-info (group info &optional server)) (deffoo nnweb-request-update-info (_group _info &optional _server))
(deffoo nnweb-asynchronous-p () (deffoo nnweb-asynchronous-p ()
nil) nil)
(deffoo nnweb-request-create-group (group &optional server args) (deffoo nnweb-request-create-group (group &optional server _args)
(nnweb-possibly-change-server nil server) (nnweb-possibly-change-server nil server)
(nnweb-request-delete-group group) (nnweb-request-delete-group group)
(push `(,group ,(cons 1 0)) nnweb-group-alist) (push `(,group ,(cons 1 0)) nnweb-group-alist)
(nnweb-write-active) (nnweb-write-active)
t) t)
(deffoo nnweb-request-delete-group (group &optional force server) (deffoo nnweb-request-delete-group (group &optional _force server)
(nnweb-possibly-change-server group server) (nnweb-possibly-change-server group server)
(gnus-alist-pull group nnweb-group-alist t) (gnus-alist-pull group nnweb-group-alist t)
(nnweb-write-active) (nnweb-write-active)
@ -317,7 +317,7 @@ Valid types include `google', `dejanews', and `gmane'.")
(let ((i 0) (let ((i 0)
(case-fold-search t) (case-fold-search t)
(active (cadr (assoc nnweb-group nnweb-group-alist))) (active (cadr (assoc nnweb-group nnweb-group-alist)))
Subject Score Date Newsgroups From Subject Date Newsgroups From
map url mid) map url mid)
(unless active (unless active
(push (list nnweb-group (setq active (cons 1 0))) (push (list nnweb-group (setq active (cons 1 0)))

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

@ -1,4 +1,4 @@
;;; score-mode.el --- mode for editing Gnus score files ;;; score-mode.el --- mode for editing Gnus score files -*- lexical-binding: t; -*-
;; Copyright (C) 1996, 2001-2021 Free Software Foundation, Inc. ;; Copyright (C) 1996, 2001-2021 Free Software Foundation, Inc.

2
lisp/gnus/smiley.el
View file

@ -1,4 +1,4 @@
;;; smiley.el --- displaying smiley faces ;;; smiley.el --- displaying smiley faces -*- lexical-binding: t; -*-
;; Copyright (C) 2000-2021 Free Software Foundation, Inc. ;; Copyright (C) 2000-2021 Free Software Foundation, Inc.

2
lisp/gnus/spam-report.el
View file

@ -1,4 +1,4 @@
;;; spam-report.el --- Reporting spam ;;; spam-report.el --- Reporting spam -*- lexical-binding: t; -*-
;; Copyright (C) 2002-2021 Free Software Foundation, Inc. ;; Copyright (C) 2002-2021 Free Software Foundation, Inc.

16
lisp/gnus/spam-stat.el
View file

@ -1,4 +1,4 @@
;;; spam-stat.el --- detecting spam based on statistics ;;; spam-stat.el --- detecting spam based on statistics -*- lexical-binding: t; -*-
;; Copyright (C) 2002-2021 Free Software Foundation, Inc. ;; Copyright (C) 2002-2021 Free Software Foundation, Inc.
@ -251,9 +251,6 @@ Use `spam-stat-ngood', `spam-stat-nbad', `spam-stat-good',
(defvar spam-stat-nbad 0 (defvar spam-stat-nbad 0
"The number of bad mails in the dictionary.") "The number of bad mails in the dictionary.")
(defvar spam-stat-error-holder nil
"A holder for condition-case errors while scoring buffers.")
(defsubst spam-stat-good (entry) (defsubst spam-stat-good (entry)
"Return the number of times this word belongs to good mails." "Return the number of times this word belongs to good mails."
(aref entry 0)) (aref entry 0))
@ -477,8 +474,8 @@ The default score for unknown words is stored in
These are the words whose spam-stat differs the most from 0.5. These are the words whose spam-stat differs the most from 0.5.
The list returned contains elements of the form \(WORD SCORE DIFF), The list returned contains elements of the form \(WORD SCORE DIFF),
where DIFF is the difference between SCORE and 0.5." where DIFF is the difference between SCORE and 0.5."
(let (result word score) (let (result score) ;; word
(maphash (lambda (word ignore) (maphash (lambda (word _ignore)
(setq score (spam-stat-score-word word) (setq score (spam-stat-score-word word)
result (cons (list word score (abs (- score 0.5))) result (cons (list word score (abs (- score 0.5)))
result))) result)))
@ -498,8 +495,7 @@ Add user supplied modifications if supplied."
(/ prod (+ prod (apply #'* (mapcar #'(lambda (x) (- 1 x)) (/ prod (+ prod (apply #'* (mapcar #'(lambda (x) (- 1 x))
probs))))) probs)))))
(score1s (score1s
(condition-case (condition-case nil
spam-stat-error-holder
(spam-stat-score-buffer-user score0) (spam-stat-score-buffer-user score0)
(error nil))) (error nil)))
(ans (ans
@ -522,7 +518,7 @@ Add user supplied modifications if supplied."
Use this function on `nnmail-split-fancy'. If you are interested in Use this function on `nnmail-split-fancy'. If you are interested in
the raw data used for the last run of `spam-stat-score-buffer', the raw data used for the last run of `spam-stat-score-buffer',
check the variable `spam-stat-score-data'." check the variable `spam-stat-score-data'."
(condition-case spam-stat-error-holder (condition-case err
(progn (progn
(set-buffer spam-stat-buffer) (set-buffer spam-stat-buffer)
(goto-char (point-min)) (goto-char (point-min))
@ -532,7 +528,7 @@ check the variable `spam-stat-score-data'."
(push entry nnmail-split-trace)) (push entry nnmail-split-trace))
spam-stat-score-data)) spam-stat-score-data))
spam-stat-split-fancy-spam-group)) spam-stat-split-fancy-spam-group))
(error (message "Error in spam-stat-split-fancy: %S" spam-stat-error-holder) (error (message "Error in spam-stat-split-fancy: %S" err)
nil))) nil)))
;; Testing ;; Testing

4
lisp/gnus/spam-wash.el
View file

@ -1,4 +1,4 @@
;;; spam-wash.el --- wash spam before analysis ;;; spam-wash.el --- wash spam before analysis -*- lexical-binding: t; -*-
;; Copyright (C) 2004, 2007-2021 Free Software Foundation, Inc. ;; Copyright (C) 2004, 2007-2021 Free Software Foundation, Inc.
@ -43,7 +43,7 @@
(handles (or (mm-dissect-buffer nil gnus-article-loose-mime) (handles (or (mm-dissect-buffer nil gnus-article-loose-mime)
(and gnus-article-emulate-mime (and gnus-article-emulate-mime
(mm-uu-dissect)))) (mm-uu-dissect))))
handle) ) ;; handle
(when gnus-article-mime-handles (when gnus-article-mime-handles
(mm-destroy-parts gnus-article-mime-handles) (mm-destroy-parts gnus-article-mime-handles)
(setq gnus-article-mime-handle-alist nil)) (setq gnus-article-mime-handle-alist nil))

24
lisp/gnus/spam.el
View file

@ -1,4 +1,4 @@
;;; spam.el --- Identifying spam ;;; spam.el --- Identifying spam -*- lexical-binding: t; -*-
;; Copyright (C) 2002-2021 Free Software Foundation, Inc. ;; Copyright (C) 2002-2021 Free Software Foundation, Inc.
@ -1387,7 +1387,7 @@ In the case of mover backends, checks the setting of
(gnus-check-backend-function (gnus-check-backend-function
'request-move-article gnus-newsgroup-name)) 'request-move-article gnus-newsgroup-name))
(respool-method (gnus-find-method-for-group gnus-newsgroup-name)) (respool-method (gnus-find-method-for-group gnus-newsgroup-name))
article mark deletep respool valid-move-destinations) deletep respool valid-move-destinations) ;; article mark
(when (member 'respool groups) (when (member 'respool groups)
(setq respool t) ; boolean for later (setq respool t) ; boolean for later
@ -1807,7 +1807,7 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details."
(log-function (if unregister (log-function (if unregister
'spam-log-undo-registration 'spam-log-undo-registration
'spam-log-processing-to-registry)) 'spam-log-processing-to-registry))
article articles) articles) ;; article
(when run-function (when run-function
;; make list of articles, using specific-articles if given ;; make list of articles, using specific-articles if given
@ -1910,7 +1910,7 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details."
;; undo a ham- or spam-processor registration (the group is not used) ;; undo a ham- or spam-processor registration (the group is not used)
(defun spam-log-undo-registration (id type classification backend (defun spam-log-undo-registration (id type classification backend
&optional group) &optional _group)
(when (and spam-log-to-registry (when (and spam-log-to-registry
(spam-log-unregistration-needed-p id type classification backend)) (spam-log-unregistration-needed-p id type classification backend))
(if (and (stringp id) (if (and (stringp id)
@ -1918,7 +1918,7 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details."
(spam-classification-valid-p classification) (spam-classification-valid-p classification)
(spam-backend-valid-p backend)) (spam-backend-valid-p backend))
(let ((cell-list (gnus-registry-get-id-key id type)) (let ((cell-list (gnus-registry-get-id-key id type))
new-cell-list found) new-cell-list) ;; found
(dolist (cell cell-list) (dolist (cell cell-list)
(unless (and (eq classification (nth 0 cell)) (unless (and (eq classification (nth 0 cell))
(eq backend (nth 1 cell))) (eq backend (nth 1 cell)))
@ -2050,7 +2050,7 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details."
(declare-function bbdb-create-internal "bbdb-com" (&rest spec)) (declare-function bbdb-create-internal "bbdb-com" (&rest spec))
;; when the BBDB changes, we want to clear out our cache ;; when the BBDB changes, we want to clear out our cache
(defun spam-clear-cache-BBDB (&rest immaterial) (defun spam-clear-cache-BBDB (&rest _immaterial)
(spam-clear-cache 'spam-use-BBDB)) (spam-clear-cache 'spam-use-BBDB))
(when (featurep 'bbdb-com) (when (featurep 'bbdb-com)
@ -2150,7 +2150,7 @@ Uses `gnus-newsgroup-name' if category is nil (for ham registration)."
(let ((category (or category gnus-newsgroup-name)) (let ((category (or category gnus-newsgroup-name))
(add-or-delete-option (if unregister "-d" "-i")) (add-or-delete-option (if unregister "-d" "-i"))
(db (spam-get-ifile-database-parameter)) (db (spam-get-ifile-database-parameter))
parameters) ) ;; parameters
(with-temp-buffer (with-temp-buffer
(dolist (article articles) (dolist (article articles)
(let ((article-string (spam-get-article-as-string article))) (let ((article-string (spam-get-article-as-string article)))
@ -2184,7 +2184,7 @@ Uses `gnus-newsgroup-name' if category is nil (for ham registration)."
"Check the spam-stat backend for the classification of this message." "Check the spam-stat backend for the classification of this message."
(let ((spam-stat-split-fancy-spam-group spam-split-group) ; override (let ((spam-stat-split-fancy-spam-group spam-split-group) ; override
(spam-stat-buffer (buffer-name)) ; stat the current buffer (spam-stat-buffer (buffer-name)) ; stat the current buffer
category return) ) ;; category return
(spam-stat-split-fancy))) (spam-stat-split-fancy)))
(defun spam-stat-register-spam-routine (articles &optional unregister) (defun spam-stat-register-spam-routine (articles &optional unregister)
@ -2335,7 +2335,7 @@ With a non-nil REMOVE, remove the ADDRESSES."
(defun spam-from-listed-p (type) (defun spam-from-listed-p (type)
(let ((from (message-fetch-field "from")) (let ((from (message-fetch-field "from"))
found) ) ;; found
(spam-filelist-check-cache type from))) (spam-filelist-check-cache type from)))
(defun spam-filelist-register-routine (articles blacklist &optional unregister) (defun spam-filelist-register-routine (articles blacklist &optional unregister)
@ -2345,7 +2345,7 @@ With a non-nil REMOVE, remove the ADDRESSES."
(if blacklist 'spam-enter-blacklist 'spam-enter-whitelist)) (if blacklist 'spam-enter-blacklist 'spam-enter-whitelist))
(remove-function (remove-function
(if blacklist 'spam-enter-whitelist 'spam-enter-blacklist)) (if blacklist 'spam-enter-whitelist 'spam-enter-blacklist))
from addresses unregister-list article-unregister-list) addresses unregister-list article-unregister-list) ;; from
(dolist (article articles) (dolist (article articles)
(let ((from (spam-fetch-field-from-fast article)) (let ((from (spam-fetch-field-from-fast article))
(id (spam-fetch-field-message-id-fast article)) (id (spam-fetch-field-message-id-fast article))
@ -2562,13 +2562,13 @@ With a non-nil REMOVE, remove the ADDRESSES."
(defun spam-spamoracle-learn-ham (articles &optional unregister) (defun spam-spamoracle-learn-ham (articles &optional unregister)
(spam-spamoracle-learn articles nil unregister)) (spam-spamoracle-learn articles nil unregister))
(defun spam-spamoracle-unlearn-ham (articles &optional unregister) (defun spam-spamoracle-unlearn-ham (articles &optional _unregister)
(spam-spamoracle-learn-ham articles t)) (spam-spamoracle-learn-ham articles t))
(defun spam-spamoracle-learn-spam (articles &optional unregister) (defun spam-spamoracle-learn-spam (articles &optional unregister)
(spam-spamoracle-learn articles t unregister)) (spam-spamoracle-learn articles t unregister))
(defun spam-spamoracle-unlearn-spam (articles &optional unregister) (defun spam-spamoracle-unlearn-spam (articles &optional _unregister)
(spam-spamoracle-learn-spam articles t)) (spam-spamoracle-learn-spam articles t))
;;}}} ;;}}}