From: Stefan Monnier Date: Sat, 30 Jan 2021 23:56:37 +0000 (-0500) Subject: * lisp/gnus: Use closures now that we activated `lexical-binding` X-Git-Tag: emacs-28.0.90~3991^2~1 X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=12189ae415f88984dd26712bdf4e4f9a50e10c8f;p=emacs.git * 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`. --- diff --git a/lisp/gnus/gnus-agent.el b/lisp/gnus/gnus-agent.el index 86c471197d5..cbe3505cd10 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 25ebc305947..39b182f2cda 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 a4bcae23bd6..f68e9d6b749 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 6d969609c4c..eec64fd217a 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 . diff --git a/lisp/gnus/gnus-html.el b/lisp/gnus/gnus-html.el index 962d7337ecd..be62bfd81f5 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 00a4f11c6c0..b0e6cb59d52 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 1bd62516b14..45e665be8c3 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 54b5a7d5fa9..a305e343f69 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 39110338c33..456e7b0f8c4 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 bbcccfee2f0..e7d1cf86161 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 f8d43253865..3c7c948c2b5 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 d550045e0a2..1ecceeedeb7 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 8f5d45d67d8..0c25c8f8bcd 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 f4c1cf9a6c8..3e36d6724ea 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 ac56e8f4b9b..9826bc6172c 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 a2de5e061e0..c6aaf460ece 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 7bd295399cc..18acc73aadd 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 2260fd694e4..7759951662a 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)))