1
Fork 0
mirror of git://git.sv.gnu.org/emacs.git synced 2026-01-03 10:31:37 -08:00

* 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.
This commit is contained in:
Stefan Monnier 2021-01-30 16:45:25 -05:00
parent acf4ec23d9
commit 9be4f41b42
23 changed files with 367 additions and 391 deletions

View file

@ -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))

View file

@ -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."

View file

@ -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

View file

@ -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)

View file

@ -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)
(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)
(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)))))))))
(put 'gnus-group-iterate 'lisp-indent-function 1)
(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)))))

View file

@ -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,11 +169,11 @@ 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\\)=\"\\([^\"]+\\)"
(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))))
(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
@ -227,7 +227,7 @@ fit these criteria."
(> height 4))
(or (null width)
(> 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)
"Display image at URL on text from START to END.

View file

@ -610,11 +610,11 @@ 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)
(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
(buffer (current-buffer))
(gnus-newsgroup-name
(if arg
(if (= 1 (prefix-numeric-value arg))
(gnus-group-completing-read
@ -622,7 +622,7 @@ If ARG is 1, prompt for a group name to find the posting style."
nil (gnus-read-active-file-p))
(gnus-group-group-name))
"")))
(gnus-setup-message 'message (message-mail)))))
(gnus-setup-message 'message (message-mail))))
(defun gnus-group-news (&optional arg)
"Start composing a news.
@ -635,11 +635,11 @@ 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)
(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
(buffer (current-buffer))
(gnus-newsgroup-name
(if arg
(if (= 1 (prefix-numeric-value arg))
(gnus-group-completing-read "Use group"
@ -649,7 +649,7 @@ network. The corresponding back end must have a `request-post' method."
"")))
(gnus-setup-message
'message
(message-news (gnus-group-real-name gnus-newsgroup-name))))))
(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,11 +678,11 @@ posting style."
(interactive "P")
;; We can't `let' gnus-newsgroup-name here, since that leads
;; to local variables leaking.
(let ((group gnus-newsgroup-name)
(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
(buffer (current-buffer))
(gnus-newsgroup-name
(if arg
(if (= 1 (prefix-numeric-value arg))
(gnus-group-completing-read "Use group"
@ -690,7 +690,7 @@ posting style."
(gnus-read-active-file-p))
"")
gnus-newsgroup-name)))
(gnus-setup-message 'message (message-mail)))))
(gnus-setup-message 'message (message-mail))))
(defun gnus-summary-news-other-window (&optional arg)
"Start composing a news in another window.
@ -703,11 +703,11 @@ 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)
(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
(buffer (current-buffer))
(gnus-newsgroup-name
(if arg
(if (= 1 (prefix-numeric-value arg))
(gnus-group-completing-read "Use group"
@ -722,7 +722,7 @@ network. The corresponding back end must have a `request-post' method."
(setq-local gnus-discouraged-post-methods
(remove
(car (gnus-find-method-for-group gnus-newsgroup-name))
gnus-discouraged-post-methods)))))))
gnus-discouraged-post-methods))))))
(defun gnus-summary-post-news (&optional arg)
"Start composing a message. Post to the current group by default.

View file

@ -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))
(set-buffer val)))
(setq new-format (symbol-value
(intern (format "gnus-%s-line-format" type)))))
(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 "%")
(setq elem
(cond
;; Do tilde forms.
((eq spec ?@)
(setq elem (list tilde-form ?s)))
(list tilde-form ?s))
;; Treat user defined format specifiers specially.
(user-defined
(setq elem
(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)))
?s))
;; Find the specification from `spec-alist'.
((setq elem (cdr (assq (or extended-spec spec) spec-alist))))
((cdr (assq (or extended-spec spec) spec-alist)))
;; We used to use "%l" for displaying the grouplens score.
((eq spec ?l)
(setq elem '("" ?s)))
'("" ?s))
(t
(setq elem '("*" ?s))))
'("*" ?s))))
(setq elem-type (cadr elem))
;; Insert the new format elements.
(when pad-width

View file

@ -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")

View file

@ -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))
(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)

View file

@ -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))

View file

@ -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)

View file

@ -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

View file

@ -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.

View file

@ -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

View file

@ -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
(setq secure-mode
(if (re-search-forward
"<#/?\\(multipart\\|part\\|external\\|mml\\)." nil t)
(setq secure-mode "multipart")
(setq secure-mode "part")))
"<#/?\\(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)))
(setq tags (cond ((string= mode "sign")
(list "sign" method))
((string= mode "encrypt")
(setq tags (list "encrypt" method)))
(list "encrypt" method))
((string= mode "signencrypt")
(setq tags (list "sign" method "encrypt" method)))
(list "sign" method "encrypt" method))
(t
(error "Unknown secure mode %s" mode)))
(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)))

View file

@ -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

View file

@ -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

View file

@ -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)
(setq split-rest
(unless (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))))
(cddr split-rest))))
(when split-rest
(goto-char end)
;; Someone might want to do a \N sub on this match, so

View file

@ -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)))))
(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 ',(car functions) args))))
(pop functions)))))
(,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
(dolist (op '(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))))
(let ((fun (nnoo-symbol backend op)))
(unless (fboundp fun)
;; FIXME: Use `defalias' and closures to avoid `eval'.
(eval `(deffoo ,fun
(&rest args)
(&rest _args)
(nnheader-report ',backend ,(format "%s-%s not implemented"
backend function))))))))
backend op))))))))
(defun nnoo-set (server &rest args)
(let ((parents (nnoo-parents (car server)))

View file

@ -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)

View file

@ -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,38 +2034,27 @@ 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)))
(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))
(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)
(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"
@ -2100,7 +2089,7 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details."
(defun spam-BBDB-unregister-routine (articles)
(spam-BBDB-register-routine articles t))
(defsubst spam-exists-in-BBDB-p (net)
(defun spam-exists-in-BBDB-p (net)
(when (and (stringp net) (not (zerop (length net))))
(bbdb-records)
(bbdb-gethash (downcase net))))
@ -2114,14 +2103,14 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details."
t
(if spam-use-BBDB-exclusive
spam-split-group
nil)))))))
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