mirror of
git://git.sv.gnu.org/emacs.git
synced 2026-04-28 01:00:52 -07:00
* lisp/gnus: Use closures now that we activated lexical-binding
* lisp/gnus/nnml.el (nnml-request-accept-article): * lisp/gnus/nnmairix.el (nnmairix-request-marks): * lisp/gnus/nnmail.el (nnmail-get-new-mail-1): * lisp/gnus/mm-view.el (mm-inline-image) (mm-inline-text-html-render-with-w3m, mm-inline-text) (mm-insert-inline, mm-inline-message): * lisp/gnus/mm-partial.el (mm-inline-partial): * lisp/gnus/mm-archive.el (mm-archive-dissect-and-inline): * lisp/gnus/gnus-util.el (gnus-create-info-command): * lisp/gnus/gnus-topic.el (gnus-topic-edit-parameters) (gnus-topic-sort-topics-1): * lisp/gnus/gnus-sum.el (gnus-summary-edit-article): * lisp/gnus/gnus-srvr.el (gnus-server-edit-server): * lisp/gnus/gnus-msg.el (gnus-inews-make-draft) (gnus-inews-add-send-actions, gnus-summary-cancel-article) (gnus-summary-supersede-article, gnus-summary-resend-message) (gnus-configure-posting-styles): * lisp/gnus/gnus-kill.el (gnus-execute): * lisp/gnus/gnus-html.el (gnus-html-wash-images): * lisp/gnus/gnus-group.el (gnus-group-edit-group) (gnus-group-nnimap-edit-acl): * lisp/gnus/gnus-draft.el (gnus-draft-edit-message, gnus-draft-setup): * lisp/gnus/gnus-art.el (gnus-article-edit-part) (gnus-mm-display-part, gnus-article-edit): * lisp/gnus/gnus-agent.el (gnus-category-edit-predicate) (gnus-category-edit-score, gnus-category-edit-groups): Use closures instead of `(lambda ...). * lisp/gnus/nnoo.el (noo--defalias): New function. (nnoo-import-1, nnoo-define-skeleton-1): Use it to avoid `eval`.
This commit is contained in:
Stefan Monnier
parent
daa4e0120d
commit
12189ae415
18 changed files with 256 additions and 242 deletions
|
|
@ -2776,16 +2776,15 @@ The following commands are available:
|
|||
(gnus-edit-form
|
||||
(gnus-agent-cat-predicate info)
|
||||
(format "Editing the select predicate for category %s" category)
|
||||
`(lambda (predicate)
|
||||
;; Avoid run-time execution of setf form
|
||||
;; (setf (gnus-agent-cat-predicate (assq ',category gnus-category-alist))
|
||||
;; predicate)
|
||||
;; use its expansion instead:
|
||||
(gnus-agent-cat-set-property (assq ',category gnus-category-alist)
|
||||
'agent-predicate predicate)
|
||||
|
||||
(gnus-category-write)
|
||||
(gnus-category-list)))))
|
||||
(lambda (predicate)
|
||||
;; Avoid run-time execution of setf form
|
||||
;; (setf (gnus-agent-cat-predicate (assq ',category gnus-category-alist))
|
||||
;; predicate)
|
||||
;; use its expansion instead:
|
||||
(gnus-agent-cat-set-property (assq category gnus-category-alist)
|
||||
'agent-predicate predicate)
|
||||
(gnus-category-write)
|
||||
(gnus-category-list)))))
|
||||
|
||||
(defun gnus-category-edit-score (category)
|
||||
"Edit the score expression for CATEGORY."
|
||||
|
|
@ -2794,16 +2793,15 @@ The following commands are available:
|
|||
(gnus-edit-form
|
||||
(gnus-agent-cat-score-file info)
|
||||
(format "Editing the score expression for category %s" category)
|
||||
`(lambda (score-file)
|
||||
;; Avoid run-time execution of setf form
|
||||
;; (setf (gnus-agent-cat-score-file (assq ',category gnus-category-alist))
|
||||
;; score-file)
|
||||
;; use its expansion instead:
|
||||
(gnus-agent-cat-set-property (assq ',category gnus-category-alist)
|
||||
'agent-score-file score-file)
|
||||
|
||||
(gnus-category-write)
|
||||
(gnus-category-list)))))
|
||||
(lambda (score-file)
|
||||
;; Avoid run-time execution of setf form
|
||||
;; (setf (gnus-agent-cat-score-file (assq ',category gnus-category-alist))
|
||||
;; score-file)
|
||||
;; use its expansion instead:
|
||||
(gnus-agent-cat-set-property (assq category gnus-category-alist)
|
||||
'agent-score-file score-file)
|
||||
(gnus-category-write)
|
||||
(gnus-category-list)))))
|
||||
|
||||
(defun gnus-category-edit-groups (category)
|
||||
"Edit the group list for CATEGORY."
|
||||
|
|
@ -2812,16 +2810,15 @@ The following commands are available:
|
|||
(gnus-edit-form
|
||||
(gnus-agent-cat-groups info)
|
||||
(format "Editing the group list for category %s" category)
|
||||
`(lambda (groups)
|
||||
;; Avoid run-time execution of setf form
|
||||
;; (setf (gnus-agent-cat-groups (assq ',category gnus-category-alist))
|
||||
;; groups)
|
||||
;; use its expansion instead:
|
||||
(gnus-agent-set-cat-groups (assq ',category gnus-category-alist)
|
||||
groups)
|
||||
|
||||
(gnus-category-write)
|
||||
(gnus-category-list)))))
|
||||
(lambda (groups)
|
||||
;; Avoid run-time execution of setf form
|
||||
;; (setf (gnus-agent-cat-groups (assq category gnus-category-alist))
|
||||
;; groups)
|
||||
;; use its expansion instead:
|
||||
(gnus-agent-set-cat-groups (assq category gnus-category-alist)
|
||||
groups)
|
||||
(gnus-category-write)
|
||||
(gnus-category-list)))))
|
||||
|
||||
(defun gnus-category-kill (category)
|
||||
"Kill the current category."
|
||||
|
|
|
|||
|
|
@ -5002,53 +5002,53 @@ General format specifiers can also be used. See Info node
|
|||
"ID of a mime part that should be buttonized.
|
||||
`gnus-mime-save-part-and-strip' and `gnus-mime-delete-part' bind it.")
|
||||
|
||||
(defvar message-options-set-recipient)
|
||||
|
||||
(eval-when-compile
|
||||
(defsubst gnus-article-edit-part (handles &optional current-id)
|
||||
"Edit an article in order to delete a mime part.
|
||||
This function is exclusively used by `gnus-mime-save-part-and-strip'
|
||||
and `gnus-mime-delete-part', and not provided at run-time normally."
|
||||
(gnus-article-edit-article
|
||||
`(lambda ()
|
||||
(buffer-disable-undo)
|
||||
(let ((mail-parse-charset (or gnus-article-charset
|
||||
',gnus-newsgroup-charset))
|
||||
(mail-parse-ignored-charsets
|
||||
(or gnus-article-ignored-charsets
|
||||
',gnus-newsgroup-ignored-charsets))
|
||||
(mbl mml-buffer-list))
|
||||
(setq mml-buffer-list nil)
|
||||
;; A new text must be inserted before deleting existing ones
|
||||
;; at the end so as not to move existing markers of which
|
||||
;; the insertion type is t.
|
||||
(delete-region
|
||||
(point-min)
|
||||
(prog1
|
||||
(goto-char (point-max))
|
||||
(insert-buffer-substring gnus-original-article-buffer)))
|
||||
(mime-to-mml ',handles)
|
||||
(setq gnus-article-mime-handles nil)
|
||||
(let ((mbl1 mml-buffer-list))
|
||||
(setq mml-buffer-list mbl)
|
||||
(setq-local mml-buffer-list mbl1))
|
||||
(add-hook 'kill-buffer-hook 'mml-destroy-buffers t t)))
|
||||
`(lambda (no-highlight)
|
||||
(let ((mail-parse-charset (or gnus-article-charset
|
||||
',gnus-newsgroup-charset))
|
||||
(message-options message-options)
|
||||
(message-options-set-recipient)
|
||||
(mail-parse-ignored-charsets
|
||||
(or gnus-article-ignored-charsets
|
||||
',gnus-newsgroup-ignored-charsets)))
|
||||
(mml-to-mime)
|
||||
(mml-destroy-buffers)
|
||||
(remove-hook 'kill-buffer-hook
|
||||
'mml-destroy-buffers t)
|
||||
(kill-local-variable 'mml-buffer-list))
|
||||
(gnus-summary-edit-article-done
|
||||
,(or (mail-header-references gnus-current-headers) "")
|
||||
,(gnus-group-read-only-p)
|
||||
,gnus-summary-buffer no-highlight))
|
||||
t)
|
||||
(let ((charset gnus-newsgroup-charset)
|
||||
(ign-cs gnus-newsgroup-ignored-charsets)
|
||||
(gch (or (mail-header-references gnus-current-headers) ""))
|
||||
(ro (gnus-group-read-only-p))
|
||||
(buf gnus-summary-buffer))
|
||||
(gnus-article-edit-article
|
||||
(lambda ()
|
||||
(buffer-disable-undo)
|
||||
(let ((mail-parse-charset (or gnus-article-charset charset))
|
||||
(mail-parse-ignored-charsets
|
||||
(or gnus-article-ignored-charsets ign-cs))
|
||||
(mbl mml-buffer-list))
|
||||
(setq mml-buffer-list nil)
|
||||
;; A new text must be inserted before deleting existing ones
|
||||
;; at the end so as not to move existing markers of which
|
||||
;; the insertion type is t.
|
||||
(delete-region
|
||||
(point-min)
|
||||
(prog1
|
||||
(goto-char (point-max))
|
||||
(insert-buffer-substring gnus-original-article-buffer)))
|
||||
(mime-to-mml handles)
|
||||
(setq gnus-article-mime-handles nil)
|
||||
(let ((mbl1 mml-buffer-list))
|
||||
(setq mml-buffer-list mbl)
|
||||
(setq-local mml-buffer-list mbl1))
|
||||
(add-hook 'kill-buffer-hook #'mml-destroy-buffers t t)))
|
||||
(lambda (no-highlight)
|
||||
(let ((mail-parse-charset (or gnus-article-charset charset))
|
||||
(message-options message-options)
|
||||
(message-options-set-recipient)
|
||||
(mail-parse-ignored-charsets
|
||||
(or gnus-article-ignored-charsets ign-cs)))
|
||||
(mml-to-mime)
|
||||
(mml-destroy-buffers)
|
||||
(remove-hook 'kill-buffer-hook
|
||||
#'mml-destroy-buffers t)
|
||||
(kill-local-variable 'mml-buffer-list))
|
||||
(gnus-summary-edit-article-done gch ro buf no-highlight))
|
||||
t))
|
||||
;; Force buttonizing this part.
|
||||
(let ((gnus-mime-buttonized-part-id current-id))
|
||||
(gnus-article-edit-done))
|
||||
|
|
@ -5768,10 +5768,11 @@ all parts."
|
|||
(mm-handle-media-type handle))
|
||||
(mm-handle-set-undisplayer
|
||||
handle
|
||||
`(lambda ()
|
||||
(let ((inhibit-read-only t))
|
||||
(delete-region ,(copy-marker (point-min) t)
|
||||
,(point-max-marker)))))))
|
||||
(let ((beg (copy-marker (point-min) t))
|
||||
(end (point-max-marker)))
|
||||
(lambda ()
|
||||
(let ((inhibit-read-only t))
|
||||
(delete-region beg end)))))))
|
||||
(part
|
||||
(mm-display-inline handle))))))
|
||||
(when (markerp point)
|
||||
|
|
@ -7280,12 +7281,13 @@ groups."
|
|||
(gnus-with-article-buffer
|
||||
(article-date-original))
|
||||
(gnus-article-edit-article
|
||||
'ignore
|
||||
`(lambda (no-highlight)
|
||||
'ignore
|
||||
(gnus-summary-edit-article-done
|
||||
,(or (mail-header-references gnus-current-headers) "")
|
||||
,(gnus-group-read-only-p) ,gnus-summary-buffer no-highlight))))
|
||||
#'ignore
|
||||
(let ((gch (or (mail-header-references gnus-current-headers) ""))
|
||||
(ro (gnus-group-read-only-p))
|
||||
(buf gnus-summary-buffer))
|
||||
(lambda (no-highlight)
|
||||
'ignore
|
||||
(gnus-summary-edit-article-done gch ro buf no-highlight)))))
|
||||
|
||||
(defun gnus-article-edit-article (start-func exit-func &optional quiet)
|
||||
"Start editing the contents of the current article buffer."
|
||||
|
|
|
|||
|
|
@ -99,10 +99,11 @@
|
|||
(let ((gnus-verbose-backends nil))
|
||||
(gnus-request-expire-articles (list article) group t))
|
||||
(push
|
||||
`((lambda ()
|
||||
(when (gnus-buffer-live-p ,gnus-summary-buffer)
|
||||
(with-current-buffer ,gnus-summary-buffer
|
||||
(gnus-cache-possibly-remove-article ,article nil nil nil t)))))
|
||||
(let ((buf gnus-summary-buffer))
|
||||
(lambda ()
|
||||
(when (gnus-buffer-live-p buf)
|
||||
(with-current-buffer buf
|
||||
(gnus-cache-possibly-remove-article article nil nil nil t)))))
|
||||
message-send-actions)))
|
||||
|
||||
(defun gnus-draft-send-message (&optional n)
|
||||
|
|
@ -274,8 +275,7 @@ If DONT-POP is nil, display the buffer after setting it up."
|
|||
(gnus-configure-posting-styles)
|
||||
(setq gnus-message-group-art (cons gnus-newsgroup-name (cadr ga)))
|
||||
(setq message-post-method
|
||||
`(lambda (arg)
|
||||
(gnus-post-method arg ,(car ga))))
|
||||
(lambda (arg) (gnus-post-method arg (car ga))))
|
||||
(unless (equal (cadr ga) "")
|
||||
(dolist (article (cdr ga))
|
||||
(message-add-action
|
||||
|
|
|
|||
|
|
@ -2930,8 +2930,8 @@ and NEW-NAME will be prompted for."
|
|||
((eq part 'params) "group parameters")
|
||||
(t "group info"))
|
||||
group)
|
||||
`(lambda (form)
|
||||
(gnus-group-edit-group-done ',part ,group form)))
|
||||
(lambda (form)
|
||||
(gnus-group-edit-group-done part group form)))
|
||||
(local-set-key
|
||||
"\C-c\C-i"
|
||||
(gnus-create-info-command
|
||||
|
|
@ -3378,9 +3378,9 @@ Editing the access control list for `%s'.
|
|||
implementation-defined hierarchy, RENAME or DELETE mailbox)
|
||||
d - delete messages (STORE \\DELETED flag, perform EXPUNGE)
|
||||
a - administer (perform SETACL)" group)
|
||||
`(lambda (form)
|
||||
(nnimap-acl-edit
|
||||
,mailbox ',method ',acl form)))))
|
||||
(lambda (form)
|
||||
(nnimap-acl-edit
|
||||
mailbox method acl form)))))
|
||||
|
||||
;; Group sorting commands
|
||||
;; Suggested by Joe Hildebrand <hildjj@idaho.fuentez.com>.
|
||||
|
|
|
|||
|
|
@ -177,9 +177,9 @@ fit these criteria."
|
|||
(add-text-properties
|
||||
start end
|
||||
(list 'image-url url
|
||||
'image-displayer `(lambda (url start end)
|
||||
(gnus-html-display-image url start end
|
||||
,alt-text))
|
||||
'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
|
||||
|
|
|
|||
|
|
@ -606,12 +606,10 @@ marked as read or ticked are ignored."
|
|||
(downcase (symbol-name header)))
|
||||
gnus-extra-headers)))
|
||||
(setq function
|
||||
`(lambda (h)
|
||||
(gnus-extra-header
|
||||
(quote ,(nth (- (length gnus-extra-headers)
|
||||
(length extras))
|
||||
gnus-extra-headers))
|
||||
h)))))))
|
||||
(let ((type (nth (- (length gnus-extra-headers)
|
||||
(length extras))
|
||||
gnus-extra-headers)))
|
||||
(lambda (h) (gnus-extra-header type h))))))))
|
||||
;; Signal error.
|
||||
(t
|
||||
(error "Unknown header field: \"%s\"" field)))
|
||||
|
|
|
|||
|
|
@ -389,9 +389,10 @@ only affect the Gcc copy, but not the original message."
|
|||
;;; Internal functions.
|
||||
|
||||
(defun gnus-inews-make-draft (articles)
|
||||
`(lambda ()
|
||||
(gnus-inews-make-draft-meta-information
|
||||
,gnus-newsgroup-name ',articles)))
|
||||
(let ((gn gnus-newsgroup-name))
|
||||
(lambda ()
|
||||
(gnus-inews-make-draft-meta-information
|
||||
gn articles))))
|
||||
|
||||
(autoload 'nnselect-article-number "nnselect" nil nil 'macro)
|
||||
(autoload 'nnselect-article-group "nnselect" nil nil 'macro)
|
||||
|
|
@ -578,8 +579,8 @@ instead."
|
|||
(when gnus-agent
|
||||
(add-hook 'message-header-hook #'gnus-agent-possibly-save-gcc nil t))
|
||||
(setq message-post-method
|
||||
`(lambda (&optional arg)
|
||||
(gnus-post-method arg ,gnus-newsgroup-name)))
|
||||
(let ((gn gnus-newsgroup-name))
|
||||
(lambda (&optional arg) (gnus-post-method arg gn))))
|
||||
(message-add-action
|
||||
`(progn
|
||||
(setq gnus-current-window-configuration ',winconf-name)
|
||||
|
|
@ -820,8 +821,8 @@ prefix `a', cancel using the standard posting method; if not
|
|||
post using the current select method."
|
||||
(interactive (gnus-interactive "P\ny"))
|
||||
(let ((message-post-method
|
||||
`(lambda (arg)
|
||||
(gnus-post-method (eq ',symp 'a) ,gnus-newsgroup-name)))
|
||||
(let ((gn gnus-newsgroup-name))
|
||||
(lambda (_arg) (gnus-post-method (eq symp 'a) gn))))
|
||||
(custom-address user-mail-address))
|
||||
(dolist (article (gnus-summary-work-articles n))
|
||||
(when (gnus-summary-select-article t nil nil article)
|
||||
|
|
@ -856,11 +857,12 @@ header line with the old Message-ID."
|
|||
(set-buffer gnus-original-article-buffer)
|
||||
(message-supersede)
|
||||
(push
|
||||
`((lambda ()
|
||||
(when (gnus-buffer-live-p ,gnus-summary-buffer)
|
||||
(with-current-buffer ,gnus-summary-buffer
|
||||
(gnus-cache-possibly-remove-article ,article nil nil nil t)
|
||||
(gnus-summary-mark-as-read ,article gnus-canceled-mark)))))
|
||||
(let ((buf gnus-summary-buffer))
|
||||
(lambda ()
|
||||
(when (gnus-buffer-live-p buf)
|
||||
(with-current-buffer buf
|
||||
(gnus-cache-possibly-remove-article article nil nil nil t)
|
||||
(gnus-summary-mark-as-read article gnus-canceled-mark)))))
|
||||
message-send-actions)
|
||||
;; Add Gcc header.
|
||||
(gnus-inews-insert-gcc))))
|
||||
|
|
@ -1387,11 +1389,12 @@ the message before resending."
|
|||
(add-hook 'message-header-setup-hook
|
||||
#'gnus-summary-resend-message-insert-gcc t)
|
||||
(add-hook 'message-sent-hook
|
||||
`(lambda ()
|
||||
(let ((rfc2047-encode-encoded-words nil))
|
||||
,(if gnus-agent
|
||||
'(gnus-agent-possibly-do-gcc)
|
||||
'(gnus-inews-do-gcc)))))
|
||||
(let ((agent gnus-agent))
|
||||
(lambda ()
|
||||
(let ((rfc2047-encode-encoded-words nil))
|
||||
(if agent
|
||||
(gnus-agent-possibly-do-gcc)
|
||||
(gnus-inews-do-gcc))))))
|
||||
(dolist (article (gnus-summary-work-articles n))
|
||||
(if no-select
|
||||
(with-current-buffer " *nntpd*"
|
||||
|
|
@ -1916,47 +1919,49 @@ this is a reply."
|
|||
((eq 'eval (car result))
|
||||
#'ignore)
|
||||
((eq 'body (car result))
|
||||
`(lambda ()
|
||||
(save-excursion
|
||||
(message-goto-body)
|
||||
(insert ,(cdr result)))))
|
||||
(let ((txt (cdr result)))
|
||||
(lambda ()
|
||||
(save-excursion
|
||||
(message-goto-body)
|
||||
(insert txt)))))
|
||||
((eq 'signature (car result))
|
||||
(setq-local message-signature nil)
|
||||
(setq-local message-signature-file nil)
|
||||
(if (not (cdr result))
|
||||
#'ignore
|
||||
`(lambda ()
|
||||
(save-excursion
|
||||
(let ((message-signature ,(cdr result)))
|
||||
(when message-signature
|
||||
(message-insert-signature)))))))
|
||||
(let ((txt (cdr result)))
|
||||
(if (not txt)
|
||||
#'ignore
|
||||
(lambda ()
|
||||
(save-excursion
|
||||
(let ((message-signature txt))
|
||||
(when message-signature
|
||||
(message-insert-signature))))))))
|
||||
(t
|
||||
(let ((header
|
||||
(if (symbolp (car result))
|
||||
(capitalize (symbol-name (car result)))
|
||||
(car result))))
|
||||
`(lambda ()
|
||||
(save-excursion
|
||||
(message-remove-header ,header)
|
||||
(let ((value ,(cdr result)))
|
||||
(when value
|
||||
(message-goto-eoh)
|
||||
(insert ,header ": " value)
|
||||
(unless (bolp)
|
||||
(insert "\n")))))))))
|
||||
(car result)))
|
||||
(value (cdr result)))
|
||||
(lambda ()
|
||||
(save-excursion
|
||||
(message-remove-header header)
|
||||
(when value
|
||||
(message-goto-eoh)
|
||||
(insert header ": " value)
|
||||
(unless (bolp)
|
||||
(insert "\n"))))))))
|
||||
nil 'local))
|
||||
(when (or name address)
|
||||
(add-hook 'message-setup-hook
|
||||
`(lambda ()
|
||||
(setq-local user-mail-address
|
||||
,(or (cdr address) user-mail-address))
|
||||
(let ((user-full-name ,(or (cdr name) (user-full-name)))
|
||||
(user-mail-address
|
||||
,(or (cdr address) user-mail-address)))
|
||||
(save-excursion
|
||||
(message-remove-header "From")
|
||||
(message-goto-eoh)
|
||||
(insert "From: " (message-make-from) "\n"))))
|
||||
(let ((name (or (cdr name) (user-full-name)))
|
||||
(email (or (cdr address) user-mail-address)))
|
||||
(lambda ()
|
||||
(setq-local user-mail-address email)
|
||||
(let ((user-full-name name)
|
||||
(user-mail-address email))
|
||||
(save-excursion
|
||||
(message-remove-header "From")
|
||||
(message-goto-eoh)
|
||||
(insert "From: " (message-make-from) "\n")))))
|
||||
nil 'local)))))
|
||||
|
||||
(defun gnus-summary-attach-article (n)
|
||||
|
|
|
|||
|
|
@ -612,10 +612,10 @@ The following commands are available:
|
|||
(gnus-close-server info)
|
||||
(gnus-edit-form
|
||||
info "Editing the server."
|
||||
`(lambda (form)
|
||||
(gnus-server-set-info ,server form)
|
||||
(gnus-server-list-servers)
|
||||
(gnus-server-position-point))
|
||||
(lambda (form)
|
||||
(gnus-server-set-info server form)
|
||||
(gnus-server-list-servers)
|
||||
(gnus-server-position-point))
|
||||
'edit-server)))
|
||||
|
||||
(defun gnus-server-show-server (server)
|
||||
|
|
|
|||
|
|
@ -10676,31 +10676,32 @@ groups."
|
|||
(setq mml-buffer-list mbl)
|
||||
(setq-local mml-buffer-list mbl1))
|
||||
(add-hook 'kill-buffer-hook #'mml-destroy-buffers t t))))
|
||||
`(lambda (no-highlight)
|
||||
(let ((mail-parse-charset ',gnus-newsgroup-charset)
|
||||
(message-options message-options)
|
||||
(message-options-set-recipient)
|
||||
(mail-parse-ignored-charsets
|
||||
',gnus-newsgroup-ignored-charsets)
|
||||
(rfc2047-header-encoding-alist
|
||||
',(let ((charset (gnus-group-name-charset
|
||||
(gnus-find-method-for-group
|
||||
gnus-newsgroup-name)
|
||||
gnus-newsgroup-name)))
|
||||
(append (list (cons "Newsgroups" charset)
|
||||
(cons "Followup-To" charset)
|
||||
(cons "Xref" charset))
|
||||
rfc2047-header-encoding-alist))))
|
||||
,(if (not raw) '(progn
|
||||
(mml-to-mime)
|
||||
(mml-destroy-buffers)
|
||||
(remove-hook 'kill-buffer-hook
|
||||
#'mml-destroy-buffers t)
|
||||
(kill-local-variable 'mml-buffer-list)))
|
||||
(gnus-summary-edit-article-done
|
||||
,(or (mail-header-references gnus-current-headers) "")
|
||||
,(gnus-group-read-only-p)
|
||||
,gnus-summary-buffer no-highlight))))))))
|
||||
(let ((charset gnus-newsgroup-charset)
|
||||
(ign-cs gnus-newsgroup-ignored-charsets)
|
||||
(hea (let ((charset (gnus-group-name-charset
|
||||
(gnus-find-method-for-group
|
||||
gnus-newsgroup-name)
|
||||
gnus-newsgroup-name)))
|
||||
(append (list (cons "Newsgroups" charset)
|
||||
(cons "Followup-To" charset)
|
||||
(cons "Xref" charset))
|
||||
rfc2047-header-encoding-alist)))
|
||||
(gch (or (mail-header-references gnus-current-headers) ""))
|
||||
(ro (gnus-group-read-only-p))
|
||||
(buf gnus-summary-buffer))
|
||||
(lambda (no-highlight)
|
||||
(let ((mail-parse-charset charset)
|
||||
(message-options message-options)
|
||||
(message-options-set-recipient)
|
||||
(mail-parse-ignored-charsets ign-cs)
|
||||
(rfc2047-header-encoding-alist hea))
|
||||
(unless raw
|
||||
(mml-to-mime)
|
||||
(mml-destroy-buffers)
|
||||
(remove-hook 'kill-buffer-hook
|
||||
#'mml-destroy-buffers t)
|
||||
(kill-local-variable 'mml-buffer-list))
|
||||
(gnus-summary-edit-article-done gch ro buf no-highlight)))))))))
|
||||
|
||||
(defalias 'gnus-summary-edit-article-postpone 'gnus-article-edit-exit)
|
||||
|
||||
|
|
|
|||
|
|
@ -1608,8 +1608,8 @@ If performed on a topic, edit the topic parameters instead."
|
|||
(gnus-topic-parameters topic)
|
||||
(format-message "Editing the topic parameters for `%s'."
|
||||
(or group topic))
|
||||
`(lambda (form)
|
||||
(gnus-topic-set-parameters ,topic form)))))))
|
||||
(lambda (form)
|
||||
(gnus-topic-set-parameters topic form)))))))
|
||||
|
||||
(defun gnus-group-sort-topic (func reverse)
|
||||
"Sort groups in the topics according to FUNC and REVERSE."
|
||||
|
|
@ -1693,9 +1693,8 @@ If REVERSE, sort in reverse order."
|
|||
(defun gnus-topic-sort-topics-1 (top reverse)
|
||||
(if (cdr top)
|
||||
(let ((subtop
|
||||
(mapcar (gnus-byte-compile
|
||||
`(lambda (top)
|
||||
(gnus-topic-sort-topics-1 top ,reverse)))
|
||||
(mapcar (lambda (top)
|
||||
(gnus-topic-sort-topics-1 top reverse))
|
||||
(sort (cdr top)
|
||||
(lambda (t1 t2)
|
||||
(string-lessp (caar t1) (caar t2)))))))
|
||||
|
|
|
|||
|
|
@ -1234,14 +1234,17 @@ sure of changing the value of `foo'."
|
|||
(cons (cons key value) (gnus-remassoc key alist))
|
||||
(gnus-remassoc key alist)))
|
||||
|
||||
(defvar gnus-info-buffer)
|
||||
(declare-function gnus-configure-windows "gnus-win" (setting &optional force))
|
||||
|
||||
(defun gnus-create-info-command (node)
|
||||
"Create a command that will go to info NODE."
|
||||
`(lambda ()
|
||||
(interactive)
|
||||
,(concat "Enter the info system at node " node)
|
||||
(Info-goto-node ,node)
|
||||
(setq gnus-info-buffer (current-buffer))
|
||||
(gnus-configure-windows 'info)))
|
||||
(lambda ()
|
||||
(:documentation (format "Enter the info system at node %s." node))
|
||||
(interactive)
|
||||
(info node)
|
||||
(setq gnus-info-buffer (current-buffer))
|
||||
(gnus-configure-windows 'info)))
|
||||
|
||||
(defun gnus-not-ignore (&rest _args)
|
||||
t)
|
||||
|
|
|
|||
|
|
@ -100,11 +100,11 @@
|
|||
(goto-char (point-max))
|
||||
(mm-handle-set-undisplayer
|
||||
handle
|
||||
`(lambda ()
|
||||
(let ((inhibit-read-only t)
|
||||
(end ,(point-marker)))
|
||||
(remove-images ,start end)
|
||||
(delete-region ,start end)))))))
|
||||
(let ((end (point-marker)))
|
||||
(lambda ()
|
||||
(let ((inhibit-read-only t))
|
||||
(remove-images start end)
|
||||
(delete-region start end))))))))
|
||||
|
||||
(provide 'mm-archive)
|
||||
|
||||
|
|
|
|||
|
|
@ -135,9 +135,11 @@ If NO-DISPLAY is nil, display it. Otherwise, do nothing after replacing."
|
|||
(mm-merge-handles gnus-article-mime-handles handles)))
|
||||
(mm-handle-set-undisplayer
|
||||
handle
|
||||
`(lambda ()
|
||||
(let (buffer-read-only)
|
||||
(delete-region ,(point-min-marker) ,(point-max-marker))))))))))
|
||||
(let ((beg (point-min-marker))
|
||||
(end (point-max-marker)))
|
||||
(lambda ()
|
||||
(let ((inhibit-read-only t))
|
||||
(delete-region beg end))))))))))
|
||||
|
||||
(provide 'mm-partial)
|
||||
|
||||
|
|
|
|||
|
|
@ -104,11 +104,10 @@ This is only used if `mm-inline-large-images' is set to
|
|||
(insert "\n")
|
||||
(mm-handle-set-undisplayer
|
||||
handle
|
||||
`(lambda ()
|
||||
(let ((b ,b)
|
||||
(inhibit-read-only t))
|
||||
(remove-images b b)
|
||||
(delete-region b (1+ b)))))))
|
||||
(lambda ()
|
||||
(let ((inhibit-read-only t))
|
||||
(remove-images b b)
|
||||
(delete-region b (1+ b)))))))
|
||||
|
||||
(defvar mm-w3m-setup nil
|
||||
"Whether gnus-article-mode has been setup to use emacs-w3m.")
|
||||
|
|
@ -202,10 +201,11 @@ This is only used if `mm-inline-large-images' is set to
|
|||
'keymap w3m-minor-mode-map)))
|
||||
(mm-handle-set-undisplayer
|
||||
handle
|
||||
`(lambda ()
|
||||
(let ((inhibit-read-only t))
|
||||
(delete-region ,(point-min-marker)
|
||||
,(point-max-marker)))))))))
|
||||
(let ((beg (point-min-marker))
|
||||
(end (point-max-marker)))
|
||||
(lambda ()
|
||||
(let ((inhibit-read-only t))
|
||||
(delete-region beg end)))))))))
|
||||
|
||||
(defcustom mm-w3m-standalone-supports-m17n-p 'undecided
|
||||
"T means the w3m command supports the m17n feature."
|
||||
|
|
@ -381,10 +381,11 @@ This is only used if `mm-inline-large-images' is set to
|
|||
handle
|
||||
(if (= (point-min) (point-max))
|
||||
#'ignore
|
||||
`(lambda ()
|
||||
(let ((inhibit-read-only t))
|
||||
(delete-region ,(copy-marker (point-min) t)
|
||||
,(point-max-marker)))))))))
|
||||
(let ((beg (copy-marker (point-min) t))
|
||||
(end (point-max-marker)))
|
||||
(lambda ()
|
||||
(let ((inhibit-read-only t))
|
||||
(delete-region beg end)))))))))
|
||||
|
||||
(defun mm-insert-inline (handle text)
|
||||
"Insert TEXT inline from HANDLE."
|
||||
|
|
@ -394,10 +395,11 @@ This is only used if `mm-inline-large-images' is set to
|
|||
(insert "\n"))
|
||||
(mm-handle-set-undisplayer
|
||||
handle
|
||||
`(lambda ()
|
||||
(let ((inhibit-read-only t))
|
||||
(delete-region ,(copy-marker b t)
|
||||
,(point-marker)))))))
|
||||
(let ((beg (copy-marker b t))
|
||||
(end (point-marker)))
|
||||
(lambda ()
|
||||
(let ((inhibit-read-only t))
|
||||
(delete-region beg end)))))))
|
||||
|
||||
(defun mm-inline-audio (_handle)
|
||||
(message "Not implemented"))
|
||||
|
|
@ -457,9 +459,11 @@ This is only used if `mm-inline-large-images' is set to
|
|||
(mm-merge-handles gnus-article-mime-handles handles)))
|
||||
(mm-handle-set-undisplayer
|
||||
handle
|
||||
`(lambda ()
|
||||
(let ((inhibit-read-only t))
|
||||
(delete-region ,(point-min-marker) ,(point-max-marker)))))))))
|
||||
(let ((beg (point-min-marker))
|
||||
(end (point-max-marker)))
|
||||
(lambda ()
|
||||
(let ((inhibit-read-only t))
|
||||
(delete-region beg end)))))))))
|
||||
|
||||
;; Shut up byte-compiler.
|
||||
(defvar font-lock-mode-hook)
|
||||
|
|
|
|||
|
|
@ -1783,7 +1783,7 @@ be called once per group or once for all groups."
|
|||
(assq 'directory mail-sources)))
|
||||
|
||||
(defun nnmail-get-new-mail-1 (method exit-func temp
|
||||
group _in-group spool-func)
|
||||
group in-group spool-func)
|
||||
(let* ((sources mail-sources)
|
||||
fetching-sources
|
||||
(i 0)
|
||||
|
|
@ -1812,10 +1812,10 @@ be called once per group or once for all groups."
|
|||
(setq source (append source
|
||||
(list
|
||||
:predicate
|
||||
(gnus-byte-compile
|
||||
`(lambda (file)
|
||||
(let ((str (concat group suffix)))
|
||||
(lambda (file)
|
||||
(string-equal
|
||||
,(concat group suffix)
|
||||
str
|
||||
(file-name-nondirectory file)))))))))
|
||||
(when nnmail-fetched-sources
|
||||
(if (member source nnmail-fetched-sources)
|
||||
|
|
@ -1836,17 +1836,19 @@ be called once per group or once for all groups."
|
|||
(condition-case cond
|
||||
(mail-source-fetch
|
||||
source
|
||||
(gnus-byte-compile
|
||||
`(lambda (file orig-file)
|
||||
(let ((smsym (intern (format "%s-save-mail" method)))
|
||||
(ansym (intern (format "%s-active-number" method)))
|
||||
(src source))
|
||||
(lambda (file orig-file)
|
||||
(nnmail-split-incoming
|
||||
file ',(intern (format "%s-save-mail" method))
|
||||
',spool-func
|
||||
file smsym
|
||||
spool-func
|
||||
(or in-group
|
||||
(if (equal file orig-file)
|
||||
nil
|
||||
(nnmail-get-split-group orig-file
|
||||
',source)))
|
||||
',(intern (format "%s-active-number" method))))))
|
||||
src)))
|
||||
ansym))))
|
||||
((error quit)
|
||||
(message "Mail source %s failed: %s" source cond)
|
||||
0)))
|
||||
|
|
|
|||
|
|
@ -701,8 +701,8 @@ Other back ends might or might not work.")
|
|||
(setf (gnus-info-read info)
|
||||
(if docorr
|
||||
(nnmairix-map-range
|
||||
;; FIXME: Use lexical-binding.
|
||||
`(lambda (x) (+ x ,(cadr corr)))
|
||||
(let ((off (cadr corr)))
|
||||
(lambda (x) (+ x off)))
|
||||
(gnus-info-read folderinfo))
|
||||
(gnus-info-read folderinfo)))
|
||||
;; set other marks
|
||||
|
|
@ -712,8 +712,8 @@ Other back ends might or might not work.")
|
|||
(cons
|
||||
(car cur)
|
||||
(nnmairix-map-range
|
||||
;; FIXME: Use lexical-binding.
|
||||
`(lambda (x) (+ x ,(cadr corr)))
|
||||
(let ((off (cadr corr)))
|
||||
(lambda (x) (+ x off)))
|
||||
(list (cadr cur)))))
|
||||
(gnus-info-marks folderinfo))
|
||||
(gnus-info-marks folderinfo))))
|
||||
|
|
|
|||
|
|
@ -411,8 +411,8 @@ non-nil.")
|
|||
(and
|
||||
(nnmail-activate 'nnml)
|
||||
(if (and (not (setq result (nnmail-article-group
|
||||
`(lambda (group)
|
||||
(nnml-active-number group ,server)))))
|
||||
(lambda (group)
|
||||
(nnml-active-number group server)))))
|
||||
(yes-or-no-p "Moved to `junk' group; delete article? "))
|
||||
(setq result 'junk)
|
||||
(setq result (car (nnml-save-mail result server t))))
|
||||
|
|
|
|||
|
|
@ -49,6 +49,9 @@
|
|||
(defun ,func ,args ,@forms)
|
||||
(nnoo-register-function ',func)))
|
||||
|
||||
(defun noo--defalias (fun val)
|
||||
(prog1 (defalias fun val) (nnoo-register-function fun)))
|
||||
|
||||
(defun nnoo-register-function (func)
|
||||
(let ((funcs (nthcdr 3 (assoc (nnoo-backend func)
|
||||
nnoo-definition-alist))))
|
||||
|
|
@ -90,9 +93,9 @@
|
|||
(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)))))))))
|
||||
(noo--defalias function
|
||||
(lambda (&rest args)
|
||||
(funcall call-function backend fun args)))))))))
|
||||
|
||||
(defun nnoo-parent-function (backend function args)
|
||||
(let ((pbackend (nnoo-backend function))
|
||||
|
|
@ -301,11 +304,9 @@ All functions will return nil and report an error."
|
|||
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 op))))))))
|
||||
(let ((msg (format "%s-%s not implemented" backend op)))
|
||||
(noo--defalias fun
|
||||
(lambda (&rest _args) (nnheader-report backend msg))))))))
|
||||
|
||||
(defun nnoo-set (server &rest args)
|
||||
(let ((parents (nnoo-parents (car server)))
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue