[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
scratch/lexical-gnus-rc 12189ae 6/6: * lisp/gnus: Use closures now that
|
From: |
Stefan Monnier |
|
Subject: |
scratch/lexical-gnus-rc 12189ae 6/6: * lisp/gnus: Use closures now that we activated `lexical-binding` |
|
Date: |
Sat, 30 Jan 2021 19:04:35 -0500 (EST) |
branch: scratch/lexical-gnus-rc
commit 12189ae415f88984dd26712bdf4e4f9a50e10c8f
Author: Stefan Monnier <monnier@iro.umontreal.ca>
Commit: Stefan Monnier <monnier@iro.umontreal.ca>
* 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`.
---
lisp/gnus/gnus-agent.el | 57 ++++++++++++--------------
lisp/gnus/gnus-art.el | 106 ++++++++++++++++++++++++------------------------
lisp/gnus/gnus-draft.el | 12 +++---
lisp/gnus/gnus-group.el | 10 ++---
lisp/gnus/gnus-html.el | 6 +--
lisp/gnus/gnus-kill.el | 10 ++---
lisp/gnus/gnus-msg.el | 101 +++++++++++++++++++++++----------------------
lisp/gnus/gnus-srvr.el | 8 ++--
lisp/gnus/gnus-sum.el | 51 +++++++++++------------
lisp/gnus/gnus-topic.el | 9 ++--
lisp/gnus/gnus-util.el | 15 ++++---
lisp/gnus/mm-archive.el | 10 ++---
lisp/gnus/mm-partial.el | 8 ++--
lisp/gnus/mm-view.el | 44 +++++++++++---------
lisp/gnus/nnmail.el | 22 +++++-----
lisp/gnus/nnmairix.el | 8 ++--
lisp/gnus/nnml.el | 4 +-
lisp/gnus/nnoo.el | 17 ++++----
18 files changed, 256 insertions(+), 242 deletions(-)
diff --git a/lisp/gnus/gnus-agent.el b/lisp/gnus/gnus-agent.el
index 86c4711..cbe3505 100644
--- a/lisp/gnus/gnus-agent.el
+++ b/lisp/gnus/gnus-agent.el
@@ -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."
diff --git a/lisp/gnus/gnus-art.el b/lisp/gnus/gnus-art.el
index 25ebc30..39b182f 100644
--- a/lisp/gnus/gnus-art.el
+++ b/lisp/gnus/gnus-art.el
@@ -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."
diff --git a/lisp/gnus/gnus-draft.el b/lisp/gnus/gnus-draft.el
index a4bcae2..f68e9d6 100644
--- a/lisp/gnus/gnus-draft.el
+++ b/lisp/gnus/gnus-draft.el
@@ -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
diff --git a/lisp/gnus/gnus-group.el b/lisp/gnus/gnus-group.el
index 6d96960..eec64fd 100644
--- a/lisp/gnus/gnus-group.el
+++ b/lisp/gnus/gnus-group.el
@@ -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>.
diff --git a/lisp/gnus/gnus-html.el b/lisp/gnus/gnus-html.el
index 962d733..be62bfd 100644
--- a/lisp/gnus/gnus-html.el
+++ b/lisp/gnus/gnus-html.el
@@ -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
diff --git a/lisp/gnus/gnus-kill.el b/lisp/gnus/gnus-kill.el
index 00a4f11..b0e6cb5 100644
--- a/lisp/gnus/gnus-kill.el
+++ b/lisp/gnus/gnus-kill.el
@@ -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)))
diff --git a/lisp/gnus/gnus-msg.el b/lisp/gnus/gnus-msg.el
index 1bd6251..45e665b 100644
--- a/lisp/gnus/gnus-msg.el
+++ b/lisp/gnus/gnus-msg.el
@@ -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)
diff --git a/lisp/gnus/gnus-srvr.el b/lisp/gnus/gnus-srvr.el
index 54b5a7d..a305e34 100644
--- a/lisp/gnus/gnus-srvr.el
+++ b/lisp/gnus/gnus-srvr.el
@@ -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)
diff --git a/lisp/gnus/gnus-sum.el b/lisp/gnus/gnus-sum.el
index 3911033..456e7b0 100644
--- a/lisp/gnus/gnus-sum.el
+++ b/lisp/gnus/gnus-sum.el
@@ -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)
diff --git a/lisp/gnus/gnus-topic.el b/lisp/gnus/gnus-topic.el
index bbcccfe..e7d1cf8 100644
--- a/lisp/gnus/gnus-topic.el
+++ b/lisp/gnus/gnus-topic.el
@@ -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)))))))
diff --git a/lisp/gnus/gnus-util.el b/lisp/gnus/gnus-util.el
index f8d4325..3c7c948 100644
--- a/lisp/gnus/gnus-util.el
+++ b/lisp/gnus/gnus-util.el
@@ -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)
diff --git a/lisp/gnus/mm-archive.el b/lisp/gnus/mm-archive.el
index d550045..1ecceee 100644
--- a/lisp/gnus/mm-archive.el
+++ b/lisp/gnus/mm-archive.el
@@ -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)
diff --git a/lisp/gnus/mm-partial.el b/lisp/gnus/mm-partial.el
index 8f5d45d..0c25c8f 100644
--- a/lisp/gnus/mm-partial.el
+++ b/lisp/gnus/mm-partial.el
@@ -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)
diff --git a/lisp/gnus/mm-view.el b/lisp/gnus/mm-view.el
index f4c1cf9..3e36d67 100644
--- a/lisp/gnus/mm-view.el
+++ b/lisp/gnus/mm-view.el
@@ -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)
diff --git a/lisp/gnus/nnmail.el b/lisp/gnus/nnmail.el
index ac56e8f..9826bc6 100644
--- a/lisp/gnus/nnmail.el
+++ b/lisp/gnus/nnmail.el
@@ -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)))
diff --git a/lisp/gnus/nnmairix.el b/lisp/gnus/nnmairix.el
index a2de5e0..c6aaf46 100644
--- a/lisp/gnus/nnmairix.el
+++ b/lisp/gnus/nnmairix.el
@@ -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))))
diff --git a/lisp/gnus/nnml.el b/lisp/gnus/nnml.el
index 7bd2953..18acc73 100644
--- a/lisp/gnus/nnml.el
+++ b/lisp/gnus/nnml.el
@@ -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))))
diff --git a/lisp/gnus/nnoo.el b/lisp/gnus/nnoo.el
index 2260fd6..7759951 100644
--- a/lisp/gnus/nnoo.el
+++ b/lisp/gnus/nnoo.el
@@ -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)))
- scratch/lexical-gnus-rc 12189ae 6/6: * lisp/gnus: Use closures now that we activated `lexical-binding`, (continued)
- scratch/lexical-gnus-rc 12189ae 6/6: * lisp/gnus: Use closures now that we activated `lexical-binding`, Stefan Monnier, 2021/01/30
- scratch/lexical-gnus-rc 9be4f41 4/6: * lisp/gnus: Misc simplifications found during conversion to lexical, Stefan Monnier, 2021/01/30
- scratch/lexical-gnus-rc daa4e01 5/6: * lisp/gnus: Use lexical-binding in all the files, Stefan Monnier, 2021/01/30
- scratch/lexical-gnus-rc acf4ec2 3/6: * lisp/gnus: Remove redundant `:group` args, Stefan Monnier, 2021/01/30
- branch scratch/lexical-gnus-rc created (now 12189ae), Stefan Monnier, 2021/01/30
- scratch/lexical-gnus-rc 8403b9a 1/6: * lisp/gnus: Use `with-current-buffer` at a few more places, Stefan Monnier, 2021/01/30
- scratch/lexical-gnus-rc acf4ec2 3/6: * lisp/gnus: Remove redundant `:group` args, Stefan Monnier, 2021/01/30
- scratch/lexical-gnus-rc 9be4f41 4/6: * lisp/gnus: Misc simplifications found during conversion to lexical, Stefan Monnier, 2021/01/30
- scratch/lexical-gnus-rc f0ca9ad 2/6: * lisp/gnus: Demote some macros and defsubsts, plus a fix, Stefan Monnier, 2021/01/30
- scratch/lexical-gnus-rc daa4e01 5/6: * lisp/gnus: Use lexical-binding in all the files, Stefan Monnier, 2021/01/30
- scratch/lexical-gnus-rc 12189ae 6/6: * lisp/gnus: Use closures now that we activated `lexical-binding`,
Stefan Monnier <=