mirror of
https://git.savannah.gnu.org/git/emacs.git
synced 2024-12-01 08:17:38 +00: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
parent
acf4ec23d9
commit
9be4f41b42
@ -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))
|
||||
|
||||
|
||||
@ -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."
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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)
|
||||
|
||||
@ -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)))))
|
||||
|
||||
|
||||
@ -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.
|
||||
|
||||
@ -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.
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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")
|
||||
|
||||
@ -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)
|
||||
|
||||
@ -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))
|
||||
|
||||
@ -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)
|
||||
|
||||
@ -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)
|
||||
|
||||
@ -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.
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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)))
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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)))
|
||||
|
||||
@ -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)
|
||||
|
||||
@ -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)))
|
||||
(require 'bbdb nil 'noerror)
|
||||
(require 'bbdb-com nil 'noerror)
|
||||
|
||||
(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))
|
||||
(declare-function bbdb-records "bbdb" ())
|
||||
(declare-function bbdb-gethash "bbdb" (key &optional predicate))
|
||||
(declare-function bbdb-create-internal "bbdb-com" (&rest spec))
|
||||
|
||||
(add-hook 'bbdb-change-hook 'spam-clear-cache-BBDB)
|
||||
;; when the BBDB changes, we want to clear out our cache
|
||||
(defun spam-clear-cache-BBDB (&rest immaterial)
|
||||
(spam-clear-cache 'spam-use-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")))))))
|
||||
(when (featurep 'bbdb-com)
|
||||
(add-hook 'bbdb-change-hook #'spam-clear-cache-BBDB))
|
||||
|
||||
(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-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-unregister-routine (articles)
|
||||
(spam-BBDB-register-routine articles t))
|
||||
(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)))
|
||||
|
||||
(defsubst spam-exists-in-BBDB-p (net)
|
||||
(when (and (stringp net) (not (zerop (length net))))
|
||||
(bbdb-records)
|
||||
(bbdb-gethash (downcase net))))
|
||||
(defun spam-BBDB-unregister-routine (articles)
|
||||
(spam-BBDB-register-routine articles t))
|
||||
|
||||
(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)))))))
|
||||
(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
|
||||
|
||||
Loading…
Reference in New Issue
Block a user