[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
scratch/lexical-gnus-rc 9be4f41 4/6: * lisp/gnus: Misc simplifications f
|
From: |
Stefan Monnier |
|
Subject: |
scratch/lexical-gnus-rc 9be4f41 4/6: * lisp/gnus: Misc simplifications found during conversion to lexical |
|
Date: |
Sat, 30 Jan 2021 18:57:39 -0500 (EST) |
branch: scratch/lexical-gnus-rc
commit 9be4f41b4254c029fc328b10ecef4e71cd2ca024
Author: Stefan Monnier <monnier@iro.umontreal.ca>
Commit: Stefan Monnier <monnier@iro.umontreal.ca>
* lisp/gnus: Misc simplifications found during conversion to lexical
* lisp/gnus/nnoo.el (noo-import-1, nnoo-define-skeleton-1): Use `dolist`.
(noo-map-functions, nnoo-define-basics): Directly emit the code rather than
going through an intermediate function; this also avoids the use of `eval`.
(noo-map-functions-1, nnoo-define-basics-1): Delete functions,
folded into their corresponding macro.
* lisp/gnus/gmm-utils.el (gmm-tool-bar-from-list): Demote `eval` to
`symbol-value`.
* lisp/gnus/gnus-art.el (gnus-button-handle-describe-key): Avoid `eval`
since `kbd` is a function nowadays.
(gnus-treat-part-number): Rename from `part-number`.
(gnus-treat-total-parts): Rename from `total-parts`.
(gnus-treat-article, gnus-treat-predicate): Adjust accordingly.
* lisp/gnus/gnus-cache.el (gnus-agent-load-alist): Use `declare-function`.
* lisp/gnus/gnus-group.el (gnus-cache-active-hashtb): Use `defvar`.
(gnus-group-iterate): Make it a normal function since lexical scoping
avoids the risk of name capture anyway.
(gnus-group-delete-articles): Actually use the `oldp` arg.
* lisp/gnus/gnus-html.el (gnus-html-wash-images): Fix debug message so
it's emitted after the `url` var it prints is actually initialized.
And avoid `setq` while we're at it.
* lisp/gnus/gnus-msg.el (gnus-group-mail, gnus-group-news)
(gnus-summary-mail-other-window, gnus-summary-news-other-window):
Merge `let`s using `let*`.
* lisp/gnus/gnus-spec.el (gnus-update-format-specifications):
Tighten the scope of `buffer`, and tighten a regexp.
(gnus-parse-simple-format): Reduce code duplication.
* lisp/gnus/gnus-start.el (gnus-child-mode): Don't `defvar` it since we
never use that variable and accordingly don't define it as a minor mode.
* lisp/gnus/gnus-util.el (gnus-byte-compile): Simplify so it obeys
`gnus-use-byte-compile` not just on the first call.
(iswitchb-minibuffer-setup): Declare.
* lisp/gnus/mail-source.el (mail-source-bind-1)
(mail-source-bind-common-1): Use `mapcar`.
(mail-source-set-common-1): Use `dolist`.
(display-time-event-handler): Declare.
* lisp/gnus/mml-smime.el (mml-smime-epg-verify): Reduce code duplication.
* lisp/gnus/mml.el (mml-parse-1): Reduce code duplication.
* lisp/gnus/mml2015.el (mml2015-epg-verify): Reduce code duplication.
* lisp/gnus/nnmail.el (nnmail-get-split-group): Tighten regexp.
(nnmail-split-it): Reduce code duplication.
* lisp/gnus/nnweb.el (nnweb-request-article): Avoid `setq`.
* lisp/gnus/spam.el (BBDB): Use the `noerror` arg of `require`, and
define all the functions for BBDB regardless if the require succeeded.
(spam-exists-in-BBDB-p): Don't inline, not worth it.
---
lisp/gnus/gmm-utils.el | 2 +-
lisp/gnus/gnus-agent.el | 2 +-
lisp/gnus/gnus-art.el | 14 ++--
lisp/gnus/gnus-cache.el | 6 +-
lisp/gnus/gnus-group.el | 50 ++++++--------
lisp/gnus/gnus-html.el | 116 ++++++++++++++++----------------
lisp/gnus/gnus-msg.el | 122 +++++++++++++++++-----------------
lisp/gnus/gnus-spec.el | 38 +++++------
lisp/gnus/gnus-start.el | 9 ++-
lisp/gnus/gnus-util.el | 17 ++---
lisp/gnus/gnus-uu.el | 1 +
lisp/gnus/mail-source.el | 34 +++++-----
lisp/gnus/mm-partial.el | 5 +-
lisp/gnus/mm-util.el | 6 +-
lisp/gnus/mml-smime.el | 8 +--
lisp/gnus/mml.el | 32 +++++----
lisp/gnus/mml2015.el | 6 +-
lisp/gnus/nnbabyl.el | 3 +-
lisp/gnus/nnmail.el | 15 +++--
lisp/gnus/nnmairix.el | 6 +-
lisp/gnus/nnoo.el | 103 ++++++++++++++---------------
lisp/gnus/nnweb.el | 10 +--
lisp/gnus/spam.el | 167 ++++++++++++++++++++++-------------------------
23 files changed, 374 insertions(+), 398 deletions(-)
diff --git a/lisp/gnus/gmm-utils.el b/lisp/gnus/gmm-utils.el
index c64bfea..3542587 100644
--- a/lisp/gnus/gmm-utils.el
+++ b/lisp/gnus/gmm-utils.el
@@ -231,7 +231,7 @@ DEFAULT-MAP specifies the default key map for ICON-LIST."
props)))
t))
(if (symbolp icon-list)
- (eval icon-list)
+ (symbol-value icon-list)
icon-list))
map))
diff --git a/lisp/gnus/gnus-agent.el b/lisp/gnus/gnus-agent.el
index cb679b8..9af19bd 100644
--- a/lisp/gnus/gnus-agent.el
+++ b/lisp/gnus/gnus-agent.el
@@ -735,7 +735,7 @@ be a select method."
(interactive "P")
(unless gnus-plugged
(error "Groups can't be fetched when Gnus is unplugged"))
- (gnus-group-iterate n 'gnus-agent-fetch-group))
+ (gnus-group-iterate n #'gnus-agent-fetch-group))
(defun gnus-agent-fetch-group (&optional group)
"Put all new articles in GROUP into the Agent."
diff --git a/lisp/gnus/gnus-art.el b/lisp/gnus/gnus-art.el
index 7e5439a..4034d36 100644
--- a/lisp/gnus/gnus-art.el
+++ b/lisp/gnus/gnus-art.el
@@ -7617,7 +7617,7 @@ Calls `describe-variable' or `describe-function'."
"Call `describe-key' when pushing the corresponding URL button."
(let* ((key-string
(replace-regexp-in-string gnus-button-handle-describe-prefix "" url))
- (keys (ignore-errors (eval `(kbd ,key-string)))))
+ (keys (ignore-errors (kbd key-string))))
(if keys
(describe-key keys)
(gnus-message 3 "Invalid key sequence in button: %s" key-string))))
@@ -8516,8 +8516,8 @@ For example:
(defvar gnus-inhibit-article-treatments nil)
;; Dynamic variables.
-(defvar part-number) ;FIXME: Lacks a "gnus-" prefix.
-(defvar total-parts) ;FIXME: Lacks a "gnus-" prefix.
+(defvar gnus-treat-part-number)
+(defvar gnus-treat-total-parts)
(defvar gnus-treat-type)
(defvar gnus-treat-condition)
(defvar gnus-treat-length)
@@ -8525,8 +8525,8 @@ For example:
(defun gnus-treat-article (condition
&optional part-num total type)
(let ((gnus-treat-condition condition)
- (part-number part-num)
- (total-parts total)
+ (gnus-treat-part-number part-num)
+ (gnus-treat-total-parts total)
(gnus-treat-type type)
(gnus-treat-length (- (point-max) (point-min)))
(alist gnus-treatment-function-alist)
@@ -8586,9 +8586,9 @@ For example:
((eq val 'head)
nil)
((eq val 'first)
- (eq part-number 1))
+ (eq gnus-treat-part-number 1))
((eq val 'last)
- (eq part-number total-parts))
+ (eq gnus-treat-part-number gnus-treat-total-parts))
((numberp val)
(< gnus-treat-length val))
(t
diff --git a/lisp/gnus/gnus-cache.el b/lisp/gnus/gnus-cache.el
index bea3d3b..b17a112 100644
--- a/lisp/gnus/gnus-cache.el
+++ b/lisp/gnus/gnus-cache.el
@@ -29,9 +29,7 @@
(require 'gnus)
(require 'gnus-sum)
-(eval-when-compile
- (unless (fboundp 'gnus-agent-load-alist)
- (defun gnus-agent-load-alist (group))))
+(declare-function gnus-agent-load-alist "gnus-agent" (group))
(defcustom gnus-cache-active-file
(expand-file-name "active" gnus-cache-directory)
@@ -55,7 +53,7 @@
If you only want to cache your nntp groups, you could set this
variable to \"^nntp\".
-If a group matches both gnus-cacheable-groups and gnus-uncacheable-groups
+If a group matches both `gnus-cacheable-groups' and `gnus-uncacheable-groups'
it's not cached."
:group 'gnus-cache
:type '(choice (const :tag "off" nil)
diff --git a/lisp/gnus/gnus-group.el b/lisp/gnus/gnus-group.el
index a165752..0444b05 100644
--- a/lisp/gnus/gnus-group.el
+++ b/lisp/gnus/gnus-group.el
@@ -40,9 +40,9 @@
(require 'mm-url)
(require 'subr-x)
(let ((features (cons 'gnus-group features)))
- (require 'gnus-sum))
- (unless (boundp 'gnus-cache-active-hashtb)
- (defvar gnus-cache-active-hashtb nil)))
+ (require 'gnus-sum)))
+
+(defvar gnus-cache-active-hashtb)
(defvar tool-bar-mode)
@@ -505,7 +505,8 @@ simple manner."
(+ number
(gnus-range-length (cdr (assq 'dormant gnus-tmp-marked)))
(gnus-range-length (cdr (assq 'tick gnus-tmp-marked))))))
- (t number)) ?s)
+ (t number))
+ ?s)
(?R gnus-tmp-number-of-read ?s)
(?U (if (gnus-active gnus-tmp-group)
(gnus-number-of-unseen-articles-in-group gnus-tmp-group)
@@ -516,7 +517,8 @@ simple manner."
(?I (gnus-range-length (cdr (assq 'dormant gnus-tmp-marked))) ?d)
(?T (gnus-range-length (cdr (assq 'tick gnus-tmp-marked))) ?d)
(?i (+ (gnus-range-length (cdr (assq 'dormant gnus-tmp-marked)))
- (gnus-range-length (cdr (assq 'tick gnus-tmp-marked)))) ?d)
+ (gnus-range-length (cdr (assq 'tick gnus-tmp-marked))))
+ ?d)
(?g gnus-tmp-group ?s)
(?G gnus-tmp-qualified-group ?s)
(?c (gnus-short-group-name gnus-tmp-group)
@@ -1541,7 +1543,8 @@ if it is a string, only list groups matching REGEXP."
(gnus-tmp-news-method-string
(if gnus-tmp-method
(format "(%s:%s)" (car gnus-tmp-method)
- (cadr gnus-tmp-method)) ""))
+ (cadr gnus-tmp-method))
+ ""))
(gnus-tmp-marked-mark
(if (and (numberp number)
(zerop number)
@@ -1985,31 +1988,18 @@ Take into consideration N (the prefix) and the list of
marked groups."
(let ((group (gnus-group-group-name)))
(and group (list group))))))
-;;; !!!Surely gnus-group-iterate should be a macro instead? I can't
-;;; imagine why I went through these contortions...
-(eval-and-compile
- (let ((function (make-symbol "gnus-group-iterate-function"))
- (window (make-symbol "gnus-group-iterate-window"))
- (groups (make-symbol "gnus-group-iterate-groups"))
- (group (make-symbol "gnus-group-iterate-group")))
- (eval
- `(defun gnus-group-iterate (arg ,function)
- "Iterate FUNCTION over all process/prefixed groups.
+(defun gnus-group-iterate (arg function)
+ "Iterate FUNCTION over all process/prefixed groups.
FUNCTION will be called with the group name as the parameter
and with point over the group in question."
- (let ((,groups (gnus-group-process-prefix arg))
- (,window (selected-window))
- ,group)
- (while ,groups
- (setq ,group (car ,groups)
- ,groups (cdr ,groups))
- (select-window ,window)
- (gnus-group-remove-mark ,group)
- (save-selected-window
- (save-excursion
- (funcall ,function ,group)))))))))
-
-(put 'gnus-group-iterate 'lisp-indent-function 1)
+ (declare (indent 1))
+ (let ((window (selected-window)))
+ (dolist (group (gnus-group-process-prefix arg))
+ (select-window window)
+ (gnus-group-remove-mark group)
+ (save-selected-window
+ (save-excursion
+ (funcall function group))))))
;; Selecting groups.
@@ -2807,7 +2797,7 @@ not-expirable articles, too."
(format "Do you really want to delete these %d articles forever? "
(length articles)))
(gnus-request-expire-articles articles group
- (if current-prefix-arg
+ (if oldp
nil
'force)))))
diff --git a/lisp/gnus/gnus-html.el b/lisp/gnus/gnus-html.el
index 855d085..6a0cc0b 100644
--- a/lisp/gnus/gnus-html.el
+++ b/lisp/gnus/gnus-html.el
@@ -151,7 +151,7 @@ fit these criteria."
(defun gnus-html-wash-images ()
"Run through current buffer and replace img tags by images."
- (let (tag parameters string start end images url alt-text
+ (let (tag parameters string start end images
inhibit-images blocked-images)
(if (buffer-live-p gnus-summary-buffer)
(with-current-buffer gnus-summary-buffer
@@ -169,65 +169,65 @@ fit these criteria."
(delete-region (match-beginning 0) (match-end 0)))
(setq end (point))
(when (string-match "src=\"\\([^\"]+\\)" parameters)
- (gnus-message 8 "gnus-html-wash-tags: fetching image URL %s" url)
- (setq url (gnus-html-encode-url (match-string 1 parameters))
- alt-text (when (string-match "\\(alt\\|title\\)=\"\\([^\"]+\\)"
- parameters)
- (xml-substitute-special (match-string 2 parameters))))
- (add-text-properties
- start end
- (list 'image-url url
- 'image-displayer `(lambda (url start end)
- (gnus-html-display-image url start end
- ,alt-text))
- 'help-echo alt-text
- 'button t
- 'keymap gnus-html-image-map
- 'gnus-image (list url start end alt-text)))
- (if (string-match "\\`cid:" url)
- ;; URLs with cid: have their content stashed in other
- ;; parts of the MIME structure, so just insert them
- ;; immediately.
- (let* ((handle (mm-get-content-id (substring url (match-end 0))))
- (image (when (and handle
- (not inhibit-images))
- (gnus-create-image
- (mm-with-part handle (buffer-string))
- nil t))))
- (if image
- (gnus-add-image
- 'cid
- (gnus-put-image
- (gnus-rescale-image
- image (gnus-html-maximum-image-size))
- (gnus-string-or (prog1
- (buffer-substring start end)
- (delete-region start end))
- "*")
- 'cid))
+ (let ((url (gnus-html-encode-url (match-string 1 parameters)))
+ (alt-text (when (string-match "\\(alt\\|title\\)=\"\\([^\"]+\\)"
+ parameters)
+ (xml-substitute-special (match-string 2
parameters)))))
+ (gnus-message 8 "gnus-html-wash-tags: fetching image URL %s" url)
+ (add-text-properties
+ start end
+ (list 'image-url url
+ 'image-displayer `(lambda (url start end)
+ (gnus-html-display-image url start end
+ ,alt-text))
+ 'help-echo alt-text
+ 'button t
+ 'keymap gnus-html-image-map
+ 'gnus-image (list url start end alt-text)))
+ (if (string-match "\\`cid:" url)
+ ;; URLs with cid: have their content stashed in other
+ ;; parts of the MIME structure, so just insert them
+ ;; immediately.
+ (let* ((handle (mm-get-content-id (substring url (match-end 0))))
+ (image (when (and handle
+ (not inhibit-images))
+ (gnus-create-image
+ (mm-with-part handle (buffer-string))
+ nil t))))
+ (if image
+ (gnus-add-image
+ 'cid
+ (gnus-put-image
+ (gnus-rescale-image
+ image (gnus-html-maximum-image-size))
+ (gnus-string-or (prog1
+ (buffer-substring start end)
+ (delete-region start end))
+ "*")
+ 'cid))
+ (make-text-button start end
+ 'help-echo url
+ 'keymap gnus-html-image-map)))
+ ;; Normal, external URL.
+ (if (or inhibit-images
+ (gnus-html-image-url-blocked-p url blocked-images))
(make-text-button start end
'help-echo url
- 'keymap gnus-html-image-map)))
- ;; Normal, external URL.
- (if (or inhibit-images
- (gnus-html-image-url-blocked-p url blocked-images))
- (make-text-button start end
- 'help-echo url
- 'keymap gnus-html-image-map)
- ;; Non-blocked url
- (let ((width
- (when (string-match "width=\"?\\([0-9]+\\)" parameters)
- (string-to-number (match-string 1 parameters))))
- (height
- (when (string-match "height=\"?\\([0-9]+\\)" parameters)
- (string-to-number (match-string 1 parameters)))))
- ;; Don't fetch images that are really small. They're
- ;; probably tracking pictures.
- (when (and (or (null height)
- (> height 4))
- (or (null width)
- (> width 4)))
- (gnus-html-display-image url start end alt-text)))))))))
+ 'keymap gnus-html-image-map)
+ ;; Non-blocked url
+ (let ((width
+ (when (string-match "width=\"?\\([0-9]+\\)" parameters)
+ (string-to-number (match-string 1 parameters))))
+ (height
+ (when (string-match "height=\"?\\([0-9]+\\)" parameters)
+ (string-to-number (match-string 1 parameters)))))
+ ;; Don't fetch images that are really small. They're
+ ;; probably tracking pictures.
+ (when (and (or (null height)
+ (> height 4))
+ (or (null width)
+ (> width 4)))
+ (gnus-html-display-image url start end alt-text))))))))))
(defun gnus-html-display-image (url start end &optional alt-text)
"Display image at URL on text from START to END.
diff --git a/lisp/gnus/gnus-msg.el b/lisp/gnus/gnus-msg.el
index 9ca82f8..49be704 100644
--- a/lisp/gnus/gnus-msg.el
+++ b/lisp/gnus/gnus-msg.el
@@ -610,19 +610,19 @@ If ARG is 1, prompt for a group name to find the posting
style."
(interactive "P")
;; We can't `let' gnus-newsgroup-name here, since that leads
;; to local variables leaking.
- (let ((group gnus-newsgroup-name)
- ;; make sure last viewed article doesn't affect posting styles:
- (gnus-article-copy)
- (buffer (current-buffer)))
- (let ((gnus-newsgroup-name
- (if arg
- (if (= 1 (prefix-numeric-value arg))
- (gnus-group-completing-read
- "Use posting style of group"
- nil (gnus-read-active-file-p))
- (gnus-group-group-name))
- "")))
- (gnus-setup-message 'message (message-mail)))))
+ (let* ((group gnus-newsgroup-name)
+ ;; make sure last viewed article doesn't affect posting styles:
+ (gnus-article-copy)
+ (buffer (current-buffer))
+ (gnus-newsgroup-name
+ (if arg
+ (if (= 1 (prefix-numeric-value arg))
+ (gnus-group-completing-read
+ "Use posting style of group"
+ nil (gnus-read-active-file-p))
+ (gnus-group-group-name))
+ "")))
+ (gnus-setup-message 'message (message-mail))))
(defun gnus-group-news (&optional arg)
"Start composing a news.
@@ -635,21 +635,21 @@ network. The corresponding back end must have a
`request-post' method."
(interactive "P")
;; We can't `let' gnus-newsgroup-name here, since that leads
;; to local variables leaking.
- (let ((group gnus-newsgroup-name)
- ;; make sure last viewed article doesn't affect posting styles:
- (gnus-article-copy)
- (buffer (current-buffer)))
- (let ((gnus-newsgroup-name
- (if arg
- (if (= 1 (prefix-numeric-value arg))
- (gnus-group-completing-read "Use group"
- nil
- (gnus-read-active-file-p))
- (gnus-group-group-name))
- "")))
- (gnus-setup-message
- 'message
- (message-news (gnus-group-real-name gnus-newsgroup-name))))))
+ (let* ((group gnus-newsgroup-name)
+ ;; make sure last viewed article doesn't affect posting styles:
+ (gnus-article-copy)
+ (buffer (current-buffer))
+ (gnus-newsgroup-name
+ (if arg
+ (if (= 1 (prefix-numeric-value arg))
+ (gnus-group-completing-read "Use group"
+ nil
+ (gnus-read-active-file-p))
+ (gnus-group-group-name))
+ "")))
+ (gnus-setup-message
+ 'message
+ (message-news (gnus-group-real-name gnus-newsgroup-name)))))
(defun gnus-group-post-news (&optional arg)
"Start composing a message (a news by default).
@@ -678,19 +678,19 @@ posting style."
(interactive "P")
;; We can't `let' gnus-newsgroup-name here, since that leads
;; to local variables leaking.
- (let ((group gnus-newsgroup-name)
- ;; make sure last viewed article doesn't affect posting styles:
- (gnus-article-copy)
- (buffer (current-buffer)))
- (let ((gnus-newsgroup-name
- (if arg
- (if (= 1 (prefix-numeric-value arg))
- (gnus-group-completing-read "Use group"
- nil
- (gnus-read-active-file-p))
- "")
- gnus-newsgroup-name)))
- (gnus-setup-message 'message (message-mail)))))
+ (let* ((group gnus-newsgroup-name)
+ ;; make sure last viewed article doesn't affect posting styles:
+ (gnus-article-copy)
+ (buffer (current-buffer))
+ (gnus-newsgroup-name
+ (if arg
+ (if (= 1 (prefix-numeric-value arg))
+ (gnus-group-completing-read "Use group"
+ nil
+ (gnus-read-active-file-p))
+ "")
+ gnus-newsgroup-name)))
+ (gnus-setup-message 'message (message-mail))))
(defun gnus-summary-news-other-window (&optional arg)
"Start composing a news in another window.
@@ -703,26 +703,26 @@ network. The corresponding back end must have a
`request-post' method."
(interactive "P")
;; We can't `let' gnus-newsgroup-name here, since that leads
;; to local variables leaking.
- (let ((group gnus-newsgroup-name)
- ;; make sure last viewed article doesn't affect posting styles:
- (gnus-article-copy)
- (buffer (current-buffer)))
- (let ((gnus-newsgroup-name
- (if arg
- (if (= 1 (prefix-numeric-value arg))
- (gnus-group-completing-read "Use group"
- nil
- (gnus-read-active-file-p))
- "")
- gnus-newsgroup-name)))
- (gnus-setup-message
- 'message
- (progn
- (message-news (gnus-group-real-name gnus-newsgroup-name))
- (setq-local gnus-discouraged-post-methods
- (remove
- (car (gnus-find-method-for-group gnus-newsgroup-name))
- gnus-discouraged-post-methods)))))))
+ (let* ((group gnus-newsgroup-name)
+ ;; make sure last viewed article doesn't affect posting styles:
+ (gnus-article-copy)
+ (buffer (current-buffer))
+ (gnus-newsgroup-name
+ (if arg
+ (if (= 1 (prefix-numeric-value arg))
+ (gnus-group-completing-read "Use group"
+ nil
+ (gnus-read-active-file-p))
+ "")
+ gnus-newsgroup-name)))
+ (gnus-setup-message
+ 'message
+ (progn
+ (message-news (gnus-group-real-name gnus-newsgroup-name))
+ (setq-local gnus-discouraged-post-methods
+ (remove
+ (car (gnus-find-method-for-group gnus-newsgroup-name))
+ gnus-discouraged-post-methods))))))
(defun gnus-summary-post-news (&optional arg)
"Start composing a message. Post to the current group by default.
diff --git a/lisp/gnus/gnus-spec.el b/lisp/gnus/gnus-spec.el
index 0dfa9f9..a50d9f3 100644
--- a/lisp/gnus/gnus-spec.el
+++ b/lisp/gnus/gnus-spec.el
@@ -151,9 +151,9 @@ Return a list of updated types."
(when (and (boundp buffer)
(setq val (symbol-value buffer))
(gnus-buffer-live-p val))
- (set-buffer val))
- (setq new-format (symbol-value
- (intern (format "gnus-%s-line-format" type)))))
+ (set-buffer val)))
+ (setq new-format (symbol-value
+ (intern (format "gnus-%s-line-format" type))))
(setq entry (cdr (assq type gnus-format-specs)))
(if (and (car entry)
(equal (car entry) new-format))
@@ -170,7 +170,7 @@ Return a list of updated types."
new-format
(symbol-value
(intern (format "gnus-%s-line-format-alist" type)))
- (not (string-match "mode$" (symbol-name type))))))
+ (not (string-match "mode\\'" (symbol-name type))))))
;; Enter the new format spec into the list.
(if entry
(progn
@@ -526,13 +526,13 @@ or to characters when given a pad value."
(if (eq spec ?%)
;; "%%" just results in a "%".
(insert "%")
- (cond
- ;; Do tilde forms.
- ((eq spec ?@)
- (setq elem (list tilde-form ?s)))
- ;; Treat user defined format specifiers specially.
- (user-defined
- (setq elem
+ (setq elem
+ (cond
+ ;; Do tilde forms.
+ ((eq spec ?@)
+ (list tilde-form ?s))
+ ;; Treat user defined format specifiers specially.
+ (user-defined
(list
(list (intern (format
(if (stringp user-defined)
@@ -540,14 +540,14 @@ or to characters when given a pad value."
"gnus-user-format-function-%c")
user-defined))
'gnus-tmp-header)
- ?s)))
- ;; Find the specification from `spec-alist'.
- ((setq elem (cdr (assq (or extended-spec spec) spec-alist))))
- ;; We used to use "%l" for displaying the grouplens score.
- ((eq spec ?l)
- (setq elem '("" ?s)))
- (t
- (setq elem '("*" ?s))))
+ ?s))
+ ;; Find the specification from `spec-alist'.
+ ((cdr (assq (or extended-spec spec) spec-alist)))
+ ;; We used to use "%l" for displaying the grouplens score.
+ ((eq spec ?l)
+ '("" ?s))
+ (t
+ '("*" ?s))))
(setq elem-type (cadr elem))
;; Insert the new format elements.
(when pad-width
diff --git a/lisp/gnus/gnus-start.el b/lisp/gnus/gnus-start.el
index a315959..1554635 100644
--- a/lisp/gnus/gnus-start.el
+++ b/lisp/gnus/gnus-start.el
@@ -2337,7 +2337,7 @@ If FORCE is non-nil, the .newsrc file is read."
gnus-newsrc-file-version gnus-version)))))))
(defun gnus-convert-mark-converter-prompt (converter no-prompt)
- "Indicate whether CONVERTER requires gnus-convert-old-newsrc to
+ "Indicate whether CONVERTER requires `gnus-convert-old-newsrc' to
display the conversion prompt. NO-PROMPT may be nil (prompt),
t (no prompt), or any form that can be called as a function.
The form should return either t or nil."
@@ -2989,13 +2989,12 @@ SPECIFIC-VARIABLES, or those in `gnus-variable-list'."
;;; Child functions.
;;;
-(defvar gnus-child-mode nil)
+;; (defvar gnus-child-mode nil)
(defun gnus-child-mode ()
"Minor mode for child Gnusae."
- ;; FIXME: gnus-child-mode appears to never be set (i.e. it'll always be nil):
- ;; Remove, or fix and use define-minor-mode.
- (add-minor-mode 'gnus-child-mode " Child" (make-sparse-keymap))
+ ;; FIXME: gnus-child-mode appears to never be set (i.e. it'll always be nil).
+ ;; (add-minor-mode 'gnus-child-mode " Child" (make-sparse-keymap))
(gnus-run-hooks 'gnus-child-mode-hook))
(define-obsolete-function-alias 'gnus-slave-mode #'gnus-child-mode "28.1")
diff --git a/lisp/gnus/gnus-util.el b/lisp/gnus/gnus-util.el
index b845102..408293f 100644
--- a/lisp/gnus/gnus-util.el
+++ b/lisp/gnus/gnus-util.el
@@ -1203,9 +1203,7 @@ ARG is passed to the first function."
(string-equal (downcase x) (downcase y)))))
(defcustom gnus-use-byte-compile t
- "If non-nil, byte-compile crucial run-time code.
-Setting it to nil has no effect after the first time `gnus-byte-compile'
-is run."
+ "If non-nil, byte-compile crucial run-time code."
:type 'boolean
:version "22.1"
:group 'gnus-various)
@@ -1213,13 +1211,8 @@ is run."
(defun gnus-byte-compile (form)
"Byte-compile FORM if `gnus-use-byte-compile' is non-nil."
(if gnus-use-byte-compile
- (progn
- (require 'bytecomp)
- (defalias 'gnus-byte-compile
- (lambda (form)
- (let ((byte-compile-warnings '(unresolved callargs redefine)))
- (byte-compile form))))
- (gnus-byte-compile form))
+ (let ((byte-compile-warnings '(unresolved callargs redefine)))
+ (byte-compile form))
form))
(defun gnus-remassoc (key alist)
@@ -1385,6 +1378,7 @@ SPEC is a predicate specifier that contains stuff like
`or', `and',
(declare-function iswitchb-read-buffer "iswitchb"
(prompt &optional default require-match
_predicate start matches-set))
+(declare-function iswitchb-minibuffer-setup "iswitchb")
(defvar iswitchb-temp-buflist)
(defvar iswitchb-mode)
@@ -1449,7 +1443,8 @@ CHOICE is a list of the choice char and help message at
IDX."
prompt
(concat
(mapconcat (lambda (s) (char-to-string (car s)))
- choice ", ") ", ?"))
+ choice ", ")
+ ", ?"))
(setq tchar (read-char))
(when (not (assq tchar choice))
(setq tchar nil)
diff --git a/lisp/gnus/gnus-uu.el b/lisp/gnus/gnus-uu.el
index 2bc1f86..e4aaf92 100644
--- a/lisp/gnus/gnus-uu.el
+++ b/lisp/gnus/gnus-uu.el
@@ -1949,6 +1949,7 @@ The user will be asked for a file name."
(gnus-uu-choose-action file-name gnus-uu-ext-to-mime-list)
file-name))
(insert (format "Content-Transfer-Encoding: %s\n\n" encoding))
+ ;; FIXME: Shouldn't we set-buffer before saving the restriction? --Stef
(save-restriction
(set-buffer gnus-message-buffer)
(goto-char (point-min))
diff --git a/lisp/gnus/mail-source.el b/lisp/gnus/mail-source.el
index 212657a..4f02d86 100644
--- a/lisp/gnus/mail-source.el
+++ b/lisp/gnus/mail-source.el
@@ -380,13 +380,10 @@ All keywords that can be used must be listed here."))
;; suitable for usage in a `let' form
(eval-and-compile
(defun mail-source-bind-1 (type)
- (let* ((defaults (cdr (assq type mail-source-keyword-map)))
- default bind)
- (while (setq default (pop defaults))
- (push (list (mail-source-strip-keyword (car default))
- nil)
- bind))
- bind)))
+ (mapcar (lambda (default)
+ (list (mail-source-strip-keyword (car default))
+ nil))
+ (cdr (assq type mail-source-keyword-map)))))
(defmacro mail-source-bind (type-source &rest body)
"Return a `let' form that binds all variables in source TYPE.
@@ -476,20 +473,16 @@ the `mail-source-keyword-map' variable."
(eval-and-compile
(defun mail-source-bind-common-1 ()
- (let* ((defaults mail-source-common-keyword-map)
- default bind)
- (while (setq default (pop defaults))
- (push (list (mail-source-strip-keyword (car default))
- nil)
- bind))
- bind)))
+ (mapcar (lambda (default)
+ (list (mail-source-strip-keyword (car default))
+ nil))
+ mail-source-common-keyword-map)))
(defun mail-source-set-common-1 (source)
(let* ((type (pop source))
- (defaults mail-source-common-keyword-map)
(defaults-1 (cdr (assq type mail-source-keyword-map)))
- default value keyword)
- (while (setq default (pop defaults))
+ value keyword)
+ (dolist (default mail-source-common-keyword-map)
(set (mail-source-strip-keyword (setq keyword (car default)))
(if (setq value (plist-get source keyword))
(mail-source-value value)
@@ -919,7 +912,7 @@ authentication. To do that, you need to set the
`message-send-mail-function' variable as `message-smtpmail-send-it'
and put the following line in your ~/.gnus.el file:
-\(add-hook \\='message-send-mail-hook \\='mail-source-touch-pop)
+\(add-hook \\='message-send-mail-hook #\\='mail-source-touch-pop)
See the Gnus manual for details."
(let ((sources (if mail-source-primary-source
@@ -963,6 +956,8 @@ See the Gnus manual for details."
;; (element 0 of the vector is nil if the timer is active).
(aset mail-source-report-new-mail-idle-timer 0 nil)))
+(declare-function display-time-event-handler "time" ())
+
(defun mail-source-report-new-mail (arg)
"Toggle whether to report when new mail is available.
This only works when `display-time' is enabled."
@@ -1075,7 +1070,8 @@ This only works when `display-time' is enabled."
(if (and (imap-open server port stream authentication buf)
(imap-authenticate
user (or (cdr (assoc from mail-source-password-cache))
- password) buf))
+ password)
+ buf))
(let ((mailbox-list (if (listp mailbox) mailbox (list mailbox))))
(dolist (mailbox mailbox-list)
(when (imap-mailbox-select mailbox nil buf)
diff --git a/lisp/gnus/mm-partial.el b/lisp/gnus/mm-partial.el
index 165c191..8d4913e 100644
--- a/lisp/gnus/mm-partial.el
+++ b/lisp/gnus/mm-partial.el
@@ -39,7 +39,8 @@
gnus-newsgroup-name)
(when (search-forward id nil t)
(let ((nhandles (mm-dissect-buffer
- nil gnus-article-loose-mime)) nid)
+ nil gnus-article-loose-mime))
+ nid)
(if (consp (car nhandles))
(mm-destroy-parts nhandles)
(setq nid (cdr (assq 'id
@@ -90,7 +91,7 @@ If NO-DISPLAY is nil, display it. Otherwise, do nothing
after replacing."
(if ntotal
(if total
(unless (eq total ntotal)
- (error "The numbers of total are different"))
+ (error "The numbers of total are different"))
(setq total ntotal)))
(unless (< nn n)
(unless (eq nn n)
diff --git a/lisp/gnus/mm-util.el b/lisp/gnus/mm-util.el
index 329b9e8..be279b6 100644
--- a/lisp/gnus/mm-util.el
+++ b/lisp/gnus/mm-util.el
@@ -144,9 +144,9 @@ is not available."
;; on there being some coding system matching each `mime-charset'
;; property defined, as there should be.)
((and (mm-coding-system-p charset)
-;;; Doing this would potentially weed out incorrect charsets.
-;;; charset
-;;; (eq charset (coding-system-get charset 'mime-charset))
+ ;; Doing this would potentially weed out incorrect charsets.
+ ;; charset
+ ;; (eq charset (coding-system-get charset 'mime-charset))
)
charset)
;; Use coding system Emacs knows.
diff --git a/lisp/gnus/mml-smime.el b/lisp/gnus/mml-smime.el
index e97e3e9..eabb56b 100644
--- a/lisp/gnus/mml-smime.el
+++ b/lisp/gnus/mml-smime.el
@@ -369,7 +369,7 @@ Content-Disposition: attachment; filename=smime.p7s
(goto-char (point-max)))))
(defun mml-smime-epg-encrypt (cont)
- (let* ((inhibit-redisplay t)
+ (let* ((inhibit-redisplay t) ;FIXME: Why?
(boundary (mml-compute-boundary cont))
(cipher (mml-secure-epg-encrypt 'CMS cont)))
(delete-region (point-min) (point-max))
@@ -410,9 +410,9 @@ Content-Disposition: attachment; filename=smime.p7m
(setq plain (epg-verify-string context (mm-get-part signature) part))
(error
(mm-sec-error 'gnus-info "Failed")
- (if (eq (car error) 'quit)
- (mm-sec-status 'gnus-details "Quit.")
- (mm-sec-status 'gnus-details (format "%S" error)))
+ (mm-sec-status 'gnus-details (if (eq (car error) 'quit)
+ "Quit."
+ (format "%S" error)))
(throw 'error handle)))
(mm-sec-status
'gnus-info
diff --git a/lisp/gnus/mml.el b/lisp/gnus/mml.el
index acde958..54f8715 100644
--- a/lisp/gnus/mml.el
+++ b/lisp/gnus/mml.el
@@ -241,22 +241,24 @@ part. This is for the internal use, you should never
modify the value.")
(method (cdr (assq 'method taginfo)))
tags)
(save-excursion
- (if (re-search-forward
- "<#/?\\(multipart\\|part\\|external\\|mml\\)." nil t)
- (setq secure-mode "multipart")
- (setq secure-mode "part")))
+ (setq secure-mode
+ (if (re-search-forward
+ "<#/?\\(multipart\\|part\\|external\\|mml\\)."
+ nil t)
+ "multipart"
+ "part")))
(save-excursion
(goto-char location)
(re-search-forward "<#secure[^\n]*>\n"))
(delete-region (match-beginning 0) (match-end 0))
- (cond ((string= mode "sign")
- (setq tags (list "sign" method)))
- ((string= mode "encrypt")
- (setq tags (list "encrypt" method)))
- ((string= mode "signencrypt")
- (setq tags (list "sign" method "encrypt" method)))
- (t
- (error "Unknown secure mode %s" mode)))
+ (setq tags (cond ((string= mode "sign")
+ (list "sign" method))
+ ((string= mode "encrypt")
+ (list "encrypt" method))
+ ((string= mode "signencrypt")
+ (list "sign" method "encrypt" method))
+ (t
+ (error "Unknown secure mode %s" mode))))
(eval `(mml-insert-tag ,secure-mode
,@tags
,(if keyfile "keyfile")
@@ -1598,7 +1600,8 @@ or the `pop-to-buffer' function."
(interactive "P")
(setq mml-preview-buffer (generate-new-buffer
(concat (if raw "*Raw MIME preview of "
- "*MIME preview of ") (buffer-name))))
+ "*MIME preview of ")
+ (buffer-name))))
(require 'gnus-msg) ; for gnus-setup-posting-charset
(save-excursion
(let* ((buf (current-buffer))
@@ -1655,7 +1658,8 @@ or the `pop-to-buffer' function."
(use-local-map nil)
(add-hook 'kill-buffer-hook
(lambda ()
- (mm-destroy-parts gnus-article-mime-handles)) nil t)
+ (mm-destroy-parts gnus-article-mime-handles))
+ nil t)
(setq buffer-read-only t)
(local-set-key "q" (lambda () (interactive) (kill-buffer nil)))
(local-set-key "=" (lambda () (interactive) (delete-other-windows)))
diff --git a/lisp/gnus/mml2015.el b/lisp/gnus/mml2015.el
index 8eda593..53454bf 100644
--- a/lisp/gnus/mml2015.el
+++ b/lisp/gnus/mml2015.el
@@ -869,9 +869,9 @@ If set, it overrides the setting of
`mml2015-sign-with-sender'."
(setq plain (epg-verify-string context signature part))
(error
(mm-sec-error 'gnus-info "Failed")
- (if (eq (car error) 'quit)
- (mm-sec-status 'gnus-details "Quit.")
- (mm-sec-status 'gnus-details (mml2015-format-error error)))
+ (mm-sec-status 'gnus-details (if (eq (car error) 'quit)
+ "Quit."
+ (mml2015-format-error error)))
(throw 'error handle)))
(mm-sec-status 'gnus-info
(mml2015-epg-verify-result-to-string
diff --git a/lisp/gnus/nnbabyl.el b/lisp/gnus/nnbabyl.el
index 5149acc..41f7f62 100644
--- a/lisp/gnus/nnbabyl.el
+++ b/lisp/gnus/nnbabyl.el
@@ -263,7 +263,8 @@
(nnmail-expired-article-p
newsgroup
(buffer-substring
- (point) (progn (end-of-line) (point))) force))
+ (point) (progn (end-of-line) (point)))
+ force))
(progn
(unless (eq nnmail-expiry-target 'delete)
(with-temp-buffer
diff --git a/lisp/gnus/nnmail.el b/lisp/gnus/nnmail.el
index 59d6137..251ae65 100644
--- a/lisp/gnus/nnmail.el
+++ b/lisp/gnus/nnmail.el
@@ -712,7 +712,7 @@ If SOURCE is a directory spec, try to return the group name
component."
(if (eq (car source) 'directory)
(let ((file (file-name-nondirectory file)))
(mail-source-bind (directory source)
- (if (string-match (concat (regexp-quote suffix) "$") file)
+ (if (string-match (concat (regexp-quote suffix) "\\'") file)
(substring file 0 (match-beginning 0))
nil)))
nil))
@@ -1339,7 +1339,8 @@ to actually put the message in the right group."
(let ((success t))
(dolist (mbx (message-unquote-tokens
(message-tokenize-header
- (message-fetch-field "Newsgroups") ", ")) success)
+ (message-fetch-field "Newsgroups") ", "))
+ success)
(let ((to-newsgroup (gnus-group-prefixed-name mbx gnus-command-method)))
(or (gnus-active to-newsgroup)
(gnus-activate-group to-newsgroup)
@@ -1433,11 +1434,11 @@ See the documentation for the variable
`nnmail-split-fancy' for details."
;; we do not exclude foo.list just because
;; the header is: ``To: x-foo, foo''
(goto-char end)
- (if (and (re-search-backward (cadr split-rest)
- after-header-name t)
- (> (match-end 0) start-of-value))
- (setq split-rest nil)
- (setq split-rest (cddr split-rest))))
+ (setq split-rest
+ (unless (and (re-search-backward (cadr split-rest)
+ after-header-name t)
+ (> (match-end 0) start-of-value))
+ (cddr split-rest))))
(when split-rest
(goto-char end)
;; Someone might want to do a \N sub on this match, so
diff --git a/lisp/gnus/nnmairix.el b/lisp/gnus/nnmairix.el
index 5e8ad4f..8b3ab40 100644
--- a/lisp/gnus/nnmairix.el
+++ b/lisp/gnus/nnmairix.el
@@ -676,9 +676,9 @@ Other back ends might or might not work.")
(autoload 'nnimap-request-update-info-internal "nnimap")
(deffoo nnmairix-request-marks (group info &optional server)
-;; propagate info from underlying IMAP folder to nnmairix group
-;; This is currently experimental and must be explicitly activated
-;; with nnmairix-propagate-marks-to-nnmairix-group
+ ;; propagate info from underlying IMAP folder to nnmairix group
+ ;; This is currently experimental and must be explicitly activated
+ ;; with nnmairix-propagate-marks-to-nnmairix-group
(when server
(nnmairix-open-server server))
(let* ((qualgroup (gnus-group-prefixed-name
diff --git a/lisp/gnus/nnoo.el b/lisp/gnus/nnoo.el
index cd0a5e6..39469d1 100644
--- a/lisp/gnus/nnoo.el
+++ b/lisp/gnus/nnoo.el
@@ -85,20 +85,14 @@
(defun nnoo-import-1 (backend imports)
(let ((call-function
- (if (symbolp (car imports)) (pop imports) 'nnoo-parent-function))
- imp functions function)
- (while (setq imp (pop imports))
- (setq functions
- (or (cdr imp)
- (nnoo-functions (car imp))))
- (while functions
- (unless (fboundp
- (setq function
- (nnoo-symbol backend
- (nnoo-rest-symbol (car functions)))))
- (eval `(deffoo ,function (&rest args)
- (,call-function ',backend ',(car functions) args))))
- (pop functions)))))
+ (if (symbolp (car imports)) (pop imports) #'nnoo-parent-function)))
+ (dolist (imp imports)
+ (dolist (fun (or (cdr imp) (nnoo-functions (car imp))))
+ (let ((function (nnoo-symbol backend (nnoo-rest-symbol fun))))
+ (unless (fboundp function)
+ ;; FIXME: Use `defalias' and closures to avoid `eval'.
+ (eval `(deffoo ,function (&rest args)
+ (,call-function ',backend ',fun args)))))))))
(defun nnoo-parent-function (backend function args)
(let ((pbackend (nnoo-backend function))
@@ -131,22 +125,21 @@
(defmacro nnoo-map-functions (backend &rest maps)
(declare (indent 1))
- `(nnoo-map-functions-1 ',backend ',maps))
-
-(defun nnoo-map-functions-1 (backend maps)
- (let (m margs i)
- (while (setq m (pop maps))
- (setq i 0
- margs nil)
- (while (< i (length (cdr m)))
- (if (numberp (nth i (cdr m)))
- (push `(nth ,i args) margs)
- (push (nth i (cdr m)) margs))
- (cl-incf i))
- (eval `(deffoo ,(nnoo-symbol backend (nnoo-rest-symbol (car m)))
+ `(progn
+ ,@(mapcar
+ (lambda (m)
+ (let ((margs nil))
+ (dotimes (i (length (cdr m)))
+ (push (if (numberp (nth i (cdr m)))
+ `(nth ,i args)
+ (nth i (cdr m)))
+ margs))
+ `(deffoo ,(nnoo-symbol backend (nnoo-rest-symbol (car m)))
(&rest args)
+ (ignore args) ;; Not always used!
(nnoo-parent-function ',backend ',(car m)
- ,(cons 'list (nreverse margs))))))))
+ ,(cons 'list (nreverse margs))))))
+ maps)))
(defun nnoo-backend (symbol)
(string-match "^[^-]+-" (symbol-name symbol))
@@ -273,19 +266,27 @@
(defmacro nnoo-define-basics (backend)
"Define `close-server', `server-opened' and `status-message'."
- `(eval-and-compile
- (nnoo-define-basics-1 ',backend)))
-
-(defun nnoo-define-basics-1 (backend)
- (dolist (function '(server-opened status-message))
- (eval `(deffoo ,(nnoo-symbol backend function) (&optional server)
- (,(nnoo-symbol 'nnoo function) ',backend server))))
- (dolist (function '(close-server))
- (eval `(deffoo ,(nnoo-symbol backend function) (&optional server defs)
- (,(nnoo-symbol 'nnoo function) ',backend server))))
- (eval `(deffoo ,(nnoo-symbol backend 'open-server)
- (server &optional defs)
- (nnoo-change-server ',backend server defs))))
+ (let ((form
+ ;; We wrap the definitions in `when t' here so that a subsequent
+ ;; "real" definition of one those doesn't trigger a "defined multiple
+ ;; times" warning.
+ `(when t
+ ,@(mapcar (lambda (fun)
+ `(deffoo ,(nnoo-symbol backend fun) (&optional server)
+ (,(nnoo-symbol 'nnoo fun) ',backend server)))
+ '(server-opened status-message))
+ (deffoo ,(nnoo-symbol backend 'close-server) (&optional server _defs)
+ (,(nnoo-symbol 'nnoo 'close-server) ',backend server))
+ (deffoo ,(nnoo-symbol backend 'open-server) (server &optional defs)
+ (nnoo-change-server ',backend server defs)))))
+ ;; Wrapping with `when' has the downside that the compiler now doesn't
+ ;; "know" that these functions are defined, so to avoid "not known to be
+ ;; defined" warnings we eagerly define them during the compilation.
+ ;; This is fairly nasty since it will override previous "real" definitions
+ ;; (e.g. when compiling this in an Emacs instance that's running Gnus), but
+ ;; that's also what the previous code did, so it sucks but is not worse.
+ (eval form t)
+ form))
(defmacro nnoo-define-skeleton (backend)
"Define all required backend functions for BACKEND.
@@ -294,17 +295,17 @@ All functions will return nil and report an error."
(nnoo-define-skeleton-1 ',backend)))
(defun nnoo-define-skeleton-1 (backend)
- (let ((functions '(retrieve-headers
- request-close request-article
- request-group close-group
- request-list request-post request-list-newsgroups))
- function fun)
- (while (setq function (pop functions))
- (when (not (fboundp (setq fun (nnoo-symbol backend function))))
+ (dolist (op '(retrieve-headers
+ request-close request-article
+ request-group close-group
+ request-list request-post request-list-newsgroups))
+ (let ((fun (nnoo-symbol backend op)))
+ (unless (fboundp fun)
+ ;; FIXME: Use `defalias' and closures to avoid `eval'.
(eval `(deffoo ,fun
- (&rest args)
- (nnheader-report ',backend ,(format "%s-%s not implemented"
- backend function))))))))
+ (&rest _args)
+ (nnheader-report ',backend ,(format "%s-%s not implemented"
+ backend op))))))))
(defun nnoo-set (server &rest args)
(let ((parents (nnoo-parents (car server)))
diff --git a/lisp/gnus/nnweb.el b/lisp/gnus/nnweb.el
index 2a94825..dd71bea 100644
--- a/lisp/gnus/nnweb.el
+++ b/lisp/gnus/nnweb.el
@@ -154,17 +154,17 @@ Valid types include `google', `dejanews', and `gmane'.")
(and (stringp article)
(nnweb-definition 'id t)
(let ((fetch (nnweb-definition 'id))
- art active)
- (when (string-match "^<\\(.*\\)>$" article)
- (setq art (match-string 1 article)))
+ (art (when (string-match "^<\\(.*\\)>$" article)
+ (match-string 1 article)))
+ active)
(when (and fetch art)
(setq url (format fetch
(mm-url-form-encode-xwfu art)))
(mm-url-insert url)
(if (nnweb-definition 'reference t)
(setq article
- (funcall (nnweb-definition
- 'reference) article)))))))
+ (funcall (nnweb-definition 'reference)
+ article)))))))
(unless nnheader-callback-function
(funcall (nnweb-definition 'article)))
(nnheader-report 'nnweb "Fetched article %s" article)
diff --git a/lisp/gnus/spam.el b/lisp/gnus/spam.el
index 3f4fd36..00dcd00 100644
--- a/lisp/gnus/spam.el
+++ b/lisp/gnus/spam.el
@@ -321,8 +321,8 @@ Default to t if one of the spam-use-* variables is set."
:type 'string
:group 'spam)
-;;; TODO: deprecate this variable, it's confusing since it's a list of strings,
-;;; not regular expressions
+;; TODO: deprecate this variable, it's confusing since it's a list of strings,
+;; not regular expressions
(defcustom spam-junk-mailgroups (cons
spam-split-group
'("mail.junk" "poste.pourriel"))
@@ -1836,7 +1836,7 @@ See the Info node `(gnus)Fancy Mail Splitting' for more
details."
;; return the number of articles processed
(length articles))))
-;;; log a ham- or spam-processor invocation to the registry
+;; log a ham- or spam-processor invocation to the registry
(defun spam-log-processing-to-registry (id type classification backend group)
(when spam-log-to-registry
(if (and (stringp id)
@@ -1855,7 +1855,7 @@ See the Info node `(gnus)Fancy Mail Splitting' for more
details."
"%s call with bad ID, type, classification, spam-backend, or group"
"spam-log-processing-to-registry")))))
-;;; check if a ham- or spam-processor registration has been done
+;; check if a ham- or spam-processor registration has been done
(defun spam-log-registered-p (id type)
(when spam-log-to-registry
(if (and (stringp id)
@@ -1868,8 +1868,8 @@ See the Info node `(gnus)Fancy Mail Splitting' for more
details."
"spam-log-registered-p"))
nil))))
-;;; check what a ham- or spam-processor registration says
-;;; returns nil if conflicting registrations are found
+;; check what a ham- or spam-processor registration says
+;; returns nil if conflicting registrations are found
(defun spam-log-registration-type (id type)
(let ((count 0)
decision)
@@ -1885,7 +1885,7 @@ See the Info node `(gnus)Fancy Mail Splitting' for more
details."
decision)))
-;;; check if a ham- or spam-processor registration needs to be undone
+;; check if a ham- or spam-processor registration needs to be undone
(defun spam-log-unregistration-needed-p (id type classification backend)
(when spam-log-to-registry
(if (and (stringp id)
@@ -1908,7 +1908,7 @@ See the Info node `(gnus)Fancy Mail Splitting' for more
details."
nil))))
-;;; 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
&optional group)
(when (and spam-log-to-registry
@@ -2034,94 +2034,83 @@ See the Info node `(gnus)Fancy Mail Splitting' for more
details."
;;{{{ BBDB
-;;; original idea for spam-check-BBDB from Alexander Kotelnikov
-;;; <sacha@giotto.sj.ru>
+;; original idea for spam-check-BBDB from Alexander Kotelnikov
+;; <sacha@giotto.sj.ru>
;; all this is done inside a condition-case to trap errors
;; Autoloaded in message, which we require.
(declare-function gnus-extract-address-components "gnus-util" (from))
-(eval-and-compile
- (condition-case nil
- (progn
- (require 'bbdb)
- (require 'bbdb-com))
- (file-error
- ;; `bbdb-records' should not be bound as an autoload function
- ;; before loading bbdb because of `bbdb-hashtable-size'.
- (defalias 'bbdb-buffer 'ignore)
- (defalias 'bbdb-create-internal 'ignore)
- (defalias 'bbdb-records 'ignore)
- (defalias 'spam-BBDB-register-routine 'ignore)
- (defalias 'spam-enter-ham-BBDB 'ignore)
- (defalias 'spam-exists-in-BBDB-p 'ignore)
- (defalias 'bbdb-gethash 'ignore)
- nil)))
-
-(eval-and-compile
- (when (featurep 'bbdb-com)
- ;; when the BBDB changes, we want to clear out our cache
- (defun spam-clear-cache-BBDB (&rest immaterial)
- (spam-clear-cache 'spam-use-BBDB))
-
- (add-hook 'bbdb-change-hook 'spam-clear-cache-BBDB)
-
- (defun spam-enter-ham-BBDB (addresses &optional remove)
- "Enter an address into the BBDB; implies ham (non-spam) sender"
- (dolist (from addresses)
- (when (stringp from)
- (let* ((parsed-address (gnus-extract-address-components from))
- (name (or (nth 0 parsed-address) "Ham Sender"))
- (remove-function (if remove
- 'bbdb-delete-record-internal
- 'ignore))
- (net-address (nth 1 parsed-address))
- (record (and net-address
- (spam-exists-in-BBDB-p net-address))))
- (when net-address
- (gnus-message 6 "%s address %s %s BBDB"
- (if remove "Deleting" "Adding")
- from
- (if remove "from" "to"))
- (if record
- (funcall remove-function record)
- (bbdb-create-internal name nil net-address nil nil
- "ham sender added by spam.el")))))))
-
- (defun spam-BBDB-register-routine (articles &optional unregister)
- (let (addresses)
- (dolist (article articles)
- (when (stringp (spam-fetch-field-from-fast article))
- (push (spam-fetch-field-from-fast article) addresses)))
- ;; now do the register/unregister action
- (spam-enter-ham-BBDB addresses unregister)))
-
- (defun spam-BBDB-unregister-routine (articles)
- (spam-BBDB-register-routine articles t))
-
- (defsubst spam-exists-in-BBDB-p (net)
- (when (and (stringp net) (not (zerop (length net))))
- (bbdb-records)
- (bbdb-gethash (downcase net))))
-
- (defun spam-check-BBDB ()
- "Mail from people in the BBDB is classified as ham or non-spam"
- (let ((net (message-fetch-field "from")))
- (when net
- (setq net (nth 1 (gnus-extract-address-components net)))
- (if (spam-exists-in-BBDB-p net)
- t
- (if spam-use-BBDB-exclusive
- spam-split-group
- nil)))))))
+(require 'bbdb nil 'noerror)
+(require 'bbdb-com nil 'noerror)
+
+(declare-function bbdb-records "bbdb" ())
+(declare-function bbdb-gethash "bbdb" (key &optional predicate))
+(declare-function bbdb-create-internal "bbdb-com" (&rest spec))
+
+;; when the BBDB changes, we want to clear out our cache
+(defun spam-clear-cache-BBDB (&rest immaterial)
+ (spam-clear-cache 'spam-use-BBDB))
+
+(when (featurep 'bbdb-com)
+ (add-hook 'bbdb-change-hook #'spam-clear-cache-BBDB))
+
+(defun spam-enter-ham-BBDB (addresses &optional remove)
+ "Enter an address into the BBDB; implies ham (non-spam) sender"
+ (dolist (from addresses)
+ (when (stringp from)
+ (let* ((parsed-address (gnus-extract-address-components from))
+ (name (or (nth 0 parsed-address) "Ham Sender"))
+ (remove-function (if remove
+ 'bbdb-delete-record-internal
+ 'ignore))
+ (net-address (nth 1 parsed-address))
+ (record (and net-address
+ (spam-exists-in-BBDB-p net-address))))
+ (when net-address
+ (gnus-message 6 "%s address %s %s BBDB"
+ (if remove "Deleting" "Adding")
+ from
+ (if remove "from" "to"))
+ (if record
+ (funcall remove-function record)
+ (bbdb-create-internal name nil net-address nil nil
+ "ham sender added by spam.el")))))))
+
+(defun spam-BBDB-register-routine (articles &optional unregister)
+ (let (addresses)
+ (dolist (article articles)
+ (when (stringp (spam-fetch-field-from-fast article))
+ (push (spam-fetch-field-from-fast article) addresses)))
+ ;; now do the register/unregister action
+ (spam-enter-ham-BBDB addresses unregister)))
+
+(defun spam-BBDB-unregister-routine (articles)
+ (spam-BBDB-register-routine articles t))
+
+(defun spam-exists-in-BBDB-p (net)
+ (when (and (stringp net) (not (zerop (length net))))
+ (bbdb-records)
+ (bbdb-gethash (downcase net))))
+
+(defun spam-check-BBDB ()
+ "Mail from people in the BBDB is classified as ham or non-spam"
+ (let ((net (message-fetch-field "from")))
+ (when net
+ (setq net (nth 1 (gnus-extract-address-components net)))
+ (if (spam-exists-in-BBDB-p net)
+ t
+ (if spam-use-BBDB-exclusive
+ spam-split-group
+ nil)))))
;;}}}
;;{{{ ifile
-;;; check the ifile backend; return nil if the mail was NOT classified
-;;; as spam
+;; check the ifile backend; return nil if the mail was NOT classified
+;; as spam
(defun spam-get-ifile-database-parameter ()
@@ -2240,7 +2229,7 @@ Uses `gnus-newsgroup-name' if category is nil (for ham
registration)."
(let ((kill-whole-line t))
(kill-line)))
-;;; address can be a list, too
+;; address can be a list, too
(defun spam-enter-whitelist (address &optional remove)
"Enter ADDRESS (list or single) into the whitelist.
With a non-nil REMOVE, remove them."
@@ -2249,7 +2238,7 @@ With a non-nil REMOVE, remove them."
(setq spam-whitelist-cache nil)
(spam-clear-cache 'spam-use-whitelist))
-;;; address can be a list, too
+;; address can be a list, too
(defun spam-enter-blacklist (address &optional remove)
"Enter ADDRESS (list or single) into the blacklist.
With a non-nil REMOVE, remove them."
@@ -2310,8 +2299,8 @@ With a non-nil REMOVE, remove the ADDRESSES."
(cl-return)))
found)))
-;;; returns t if the sender is in the whitelist, nil or
-;;; spam-split-group otherwise
+;; returns t if the sender is in the whitelist, nil or
+;; spam-split-group otherwise
(defun spam-check-whitelist ()
;; FIXME! Should it detect when file timestamps change?
(unless spam-whitelist-cache
- branch scratch/lexical-gnus-rc created (now 12189ae), Stefan Monnier, 2021/01/30
- scratch/lexical-gnus-rc 8403b9a 1/6: * lisp/gnus: Use `with-current-buffer` at a few more places, Stefan Monnier, 2021/01/30
- scratch/lexical-gnus-rc f0ca9ad 2/6: * lisp/gnus: Demote some macros and defsubsts, plus a fix, Stefan Monnier, 2021/01/30
- scratch/lexical-gnus-rc 12189ae 6/6: * lisp/gnus: Use closures now that we activated `lexical-binding`, Stefan Monnier, 2021/01/30
- scratch/lexical-gnus-rc 9be4f41 4/6: * lisp/gnus: Misc simplifications found during conversion to lexical,
Stefan Monnier <=
- scratch/lexical-gnus-rc daa4e01 5/6: * lisp/gnus: Use lexical-binding in all the files, Stefan Monnier, 2021/01/30
- scratch/lexical-gnus-rc acf4ec2 3/6: * lisp/gnus: Remove redundant `:group` args, Stefan Monnier, 2021/01/30
- branch scratch/lexical-gnus-rc created (now 12189ae), Stefan Monnier, 2021/01/30
- scratch/lexical-gnus-rc 8403b9a 1/6: * lisp/gnus: Use `with-current-buffer` at a few more places, Stefan Monnier, 2021/01/30
- scratch/lexical-gnus-rc acf4ec2 3/6: * lisp/gnus: Remove redundant `:group` args, Stefan Monnier, 2021/01/30
- scratch/lexical-gnus-rc 9be4f41 4/6: * lisp/gnus: Misc simplifications found during conversion to lexical, Stefan Monnier, 2021/01/30
- scratch/lexical-gnus-rc f0ca9ad 2/6: * lisp/gnus: Demote some macros and defsubsts, plus a fix, Stefan Monnier, 2021/01/30
- scratch/lexical-gnus-rc daa4e01 5/6: * lisp/gnus: Use lexical-binding in all the files, Stefan Monnier, 2021/01/30
- scratch/lexical-gnus-rc 12189ae 6/6: * lisp/gnus: Use closures now that we activated `lexical-binding`, Stefan Monnier, 2021/01/30