diff options
| author | Stefan Monnier | 2021-01-30 18:56:37 -0500 |
|---|---|---|
| committer | Stefan Monnier | 2021-01-30 18:56:37 -0500 |
| commit | 12189ae415f88984dd26712bdf4e4f9a50e10c8f (patch) | |
| tree | 2d9bb8acc5c400a015c32fb480d2149c621922e3 | |
| parent | daa4e0120dc32a8c3eeafdf8914a0e29e5c149e9 (diff) | |
| download | emacs-scratch/lexical-gnus-rc.tar.gz emacs-scratch/lexical-gnus-rc.zip | |
* lisp/gnus: Use closures now that we activated `lexical-binding`scratch/lexical-gnus-rc
* 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`.
| -rw-r--r-- | lisp/gnus/gnus-agent.el | 57 | ||||
| -rw-r--r-- | lisp/gnus/gnus-art.el | 106 | ||||
| -rw-r--r-- | lisp/gnus/gnus-draft.el | 12 | ||||
| -rw-r--r-- | lisp/gnus/gnus-group.el | 10 | ||||
| -rw-r--r-- | lisp/gnus/gnus-html.el | 6 | ||||
| -rw-r--r-- | lisp/gnus/gnus-kill.el | 10 | ||||
| -rw-r--r-- | lisp/gnus/gnus-msg.el | 101 | ||||
| -rw-r--r-- | lisp/gnus/gnus-srvr.el | 8 | ||||
| -rw-r--r-- | lisp/gnus/gnus-sum.el | 51 | ||||
| -rw-r--r-- | lisp/gnus/gnus-topic.el | 9 | ||||
| -rw-r--r-- | lisp/gnus/gnus-util.el | 15 | ||||
| -rw-r--r-- | lisp/gnus/mm-archive.el | 10 | ||||
| -rw-r--r-- | lisp/gnus/mm-partial.el | 8 | ||||
| -rw-r--r-- | lisp/gnus/mm-view.el | 44 | ||||
| -rw-r--r-- | lisp/gnus/nnmail.el | 22 | ||||
| -rw-r--r-- | lisp/gnus/nnmairix.el | 8 | ||||
| -rw-r--r-- | lisp/gnus/nnml.el | 4 | ||||
| -rw-r--r-- | 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 86c471197d5..cbe3505cd10 100644 --- a/lisp/gnus/gnus-agent.el +++ b/lisp/gnus/gnus-agent.el | |||
| @@ -2776,16 +2776,15 @@ The following commands are available: | |||
| 2776 | (gnus-edit-form | 2776 | (gnus-edit-form |
| 2777 | (gnus-agent-cat-predicate info) | 2777 | (gnus-agent-cat-predicate info) |
| 2778 | (format "Editing the select predicate for category %s" category) | 2778 | (format "Editing the select predicate for category %s" category) |
| 2779 | `(lambda (predicate) | 2779 | (lambda (predicate) |
| 2780 | ;; Avoid run-time execution of setf form | 2780 | ;; Avoid run-time execution of setf form |
| 2781 | ;; (setf (gnus-agent-cat-predicate (assq ',category gnus-category-alist)) | 2781 | ;; (setf (gnus-agent-cat-predicate (assq ',category gnus-category-alist)) |
| 2782 | ;; predicate) | 2782 | ;; predicate) |
| 2783 | ;; use its expansion instead: | 2783 | ;; use its expansion instead: |
| 2784 | (gnus-agent-cat-set-property (assq ',category gnus-category-alist) | 2784 | (gnus-agent-cat-set-property (assq category gnus-category-alist) |
| 2785 | 'agent-predicate predicate) | 2785 | 'agent-predicate predicate) |
| 2786 | 2786 | (gnus-category-write) | |
| 2787 | (gnus-category-write) | 2787 | (gnus-category-list))))) |
| 2788 | (gnus-category-list))))) | ||
| 2789 | 2788 | ||
| 2790 | (defun gnus-category-edit-score (category) | 2789 | (defun gnus-category-edit-score (category) |
| 2791 | "Edit the score expression for CATEGORY." | 2790 | "Edit the score expression for CATEGORY." |
| @@ -2794,16 +2793,15 @@ The following commands are available: | |||
| 2794 | (gnus-edit-form | 2793 | (gnus-edit-form |
| 2795 | (gnus-agent-cat-score-file info) | 2794 | (gnus-agent-cat-score-file info) |
| 2796 | (format "Editing the score expression for category %s" category) | 2795 | (format "Editing the score expression for category %s" category) |
| 2797 | `(lambda (score-file) | 2796 | (lambda (score-file) |
| 2798 | ;; Avoid run-time execution of setf form | 2797 | ;; Avoid run-time execution of setf form |
| 2799 | ;; (setf (gnus-agent-cat-score-file (assq ',category gnus-category-alist)) | 2798 | ;; (setf (gnus-agent-cat-score-file (assq ',category gnus-category-alist)) |
| 2800 | ;; score-file) | 2799 | ;; score-file) |
| 2801 | ;; use its expansion instead: | 2800 | ;; use its expansion instead: |
| 2802 | (gnus-agent-cat-set-property (assq ',category gnus-category-alist) | 2801 | (gnus-agent-cat-set-property (assq category gnus-category-alist) |
| 2803 | 'agent-score-file score-file) | 2802 | 'agent-score-file score-file) |
| 2804 | 2803 | (gnus-category-write) | |
| 2805 | (gnus-category-write) | 2804 | (gnus-category-list))))) |
| 2806 | (gnus-category-list))))) | ||
| 2807 | 2805 | ||
| 2808 | (defun gnus-category-edit-groups (category) | 2806 | (defun gnus-category-edit-groups (category) |
| 2809 | "Edit the group list for CATEGORY." | 2807 | "Edit the group list for CATEGORY." |
| @@ -2812,16 +2810,15 @@ The following commands are available: | |||
| 2812 | (gnus-edit-form | 2810 | (gnus-edit-form |
| 2813 | (gnus-agent-cat-groups info) | 2811 | (gnus-agent-cat-groups info) |
| 2814 | (format "Editing the group list for category %s" category) | 2812 | (format "Editing the group list for category %s" category) |
| 2815 | `(lambda (groups) | 2813 | (lambda (groups) |
| 2816 | ;; Avoid run-time execution of setf form | 2814 | ;; Avoid run-time execution of setf form |
| 2817 | ;; (setf (gnus-agent-cat-groups (assq ',category gnus-category-alist)) | 2815 | ;; (setf (gnus-agent-cat-groups (assq category gnus-category-alist)) |
| 2818 | ;; groups) | 2816 | ;; groups) |
| 2819 | ;; use its expansion instead: | 2817 | ;; use its expansion instead: |
| 2820 | (gnus-agent-set-cat-groups (assq ',category gnus-category-alist) | 2818 | (gnus-agent-set-cat-groups (assq category gnus-category-alist) |
| 2821 | groups) | 2819 | groups) |
| 2822 | 2820 | (gnus-category-write) | |
| 2823 | (gnus-category-write) | 2821 | (gnus-category-list))))) |
| 2824 | (gnus-category-list))))) | ||
| 2825 | 2822 | ||
| 2826 | (defun gnus-category-kill (category) | 2823 | (defun gnus-category-kill (category) |
| 2827 | "Kill the current category." | 2824 | "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 | |||
| 5002 | "ID of a mime part that should be buttonized. | 5002 | "ID of a mime part that should be buttonized. |
| 5003 | `gnus-mime-save-part-and-strip' and `gnus-mime-delete-part' bind it.") | 5003 | `gnus-mime-save-part-and-strip' and `gnus-mime-delete-part' bind it.") |
| 5004 | 5004 | ||
| 5005 | (defvar message-options-set-recipient) | ||
| 5006 | |||
| 5005 | (eval-when-compile | 5007 | (eval-when-compile |
| 5006 | (defsubst gnus-article-edit-part (handles &optional current-id) | 5008 | (defsubst gnus-article-edit-part (handles &optional current-id) |
| 5007 | "Edit an article in order to delete a mime part. | 5009 | "Edit an article in order to delete a mime part. |
| 5008 | This function is exclusively used by `gnus-mime-save-part-and-strip' | 5010 | This function is exclusively used by `gnus-mime-save-part-and-strip' |
| 5009 | and `gnus-mime-delete-part', and not provided at run-time normally." | 5011 | and `gnus-mime-delete-part', and not provided at run-time normally." |
| 5010 | (gnus-article-edit-article | 5012 | (let ((charset gnus-newsgroup-charset) |
| 5011 | `(lambda () | 5013 | (ign-cs gnus-newsgroup-ignored-charsets) |
| 5012 | (buffer-disable-undo) | 5014 | (gch (or (mail-header-references gnus-current-headers) "")) |
| 5013 | (let ((mail-parse-charset (or gnus-article-charset | 5015 | (ro (gnus-group-read-only-p)) |
| 5014 | ',gnus-newsgroup-charset)) | 5016 | (buf gnus-summary-buffer)) |
| 5015 | (mail-parse-ignored-charsets | 5017 | (gnus-article-edit-article |
| 5016 | (or gnus-article-ignored-charsets | 5018 | (lambda () |
| 5017 | ',gnus-newsgroup-ignored-charsets)) | 5019 | (buffer-disable-undo) |
| 5018 | (mbl mml-buffer-list)) | 5020 | (let ((mail-parse-charset (or gnus-article-charset charset)) |
| 5019 | (setq mml-buffer-list nil) | 5021 | (mail-parse-ignored-charsets |
| 5020 | ;; A new text must be inserted before deleting existing ones | 5022 | (or gnus-article-ignored-charsets ign-cs)) |
| 5021 | ;; at the end so as not to move existing markers of which | 5023 | (mbl mml-buffer-list)) |
| 5022 | ;; the insertion type is t. | 5024 | (setq mml-buffer-list nil) |
| 5023 | (delete-region | 5025 | ;; A new text must be inserted before deleting existing ones |
| 5024 | (point-min) | 5026 | ;; at the end so as not to move existing markers of which |
| 5025 | (prog1 | 5027 | ;; the insertion type is t. |
| 5026 | (goto-char (point-max)) | 5028 | (delete-region |
| 5027 | (insert-buffer-substring gnus-original-article-buffer))) | 5029 | (point-min) |
| 5028 | (mime-to-mml ',handles) | 5030 | (prog1 |
| 5029 | (setq gnus-article-mime-handles nil) | 5031 | (goto-char (point-max)) |
| 5030 | (let ((mbl1 mml-buffer-list)) | 5032 | (insert-buffer-substring gnus-original-article-buffer))) |
| 5031 | (setq mml-buffer-list mbl) | 5033 | (mime-to-mml handles) |
| 5032 | (setq-local mml-buffer-list mbl1)) | 5034 | (setq gnus-article-mime-handles nil) |
| 5033 | (add-hook 'kill-buffer-hook 'mml-destroy-buffers t t))) | 5035 | (let ((mbl1 mml-buffer-list)) |
| 5034 | `(lambda (no-highlight) | 5036 | (setq mml-buffer-list mbl) |
| 5035 | (let ((mail-parse-charset (or gnus-article-charset | 5037 | (setq-local mml-buffer-list mbl1)) |
| 5036 | ',gnus-newsgroup-charset)) | 5038 | (add-hook 'kill-buffer-hook #'mml-destroy-buffers t t))) |
| 5037 | (message-options message-options) | 5039 | (lambda (no-highlight) |
| 5038 | (message-options-set-recipient) | 5040 | (let ((mail-parse-charset (or gnus-article-charset charset)) |
| 5039 | (mail-parse-ignored-charsets | 5041 | (message-options message-options) |
| 5040 | (or gnus-article-ignored-charsets | 5042 | (message-options-set-recipient) |
| 5041 | ',gnus-newsgroup-ignored-charsets))) | 5043 | (mail-parse-ignored-charsets |
| 5042 | (mml-to-mime) | 5044 | (or gnus-article-ignored-charsets ign-cs))) |
| 5043 | (mml-destroy-buffers) | 5045 | (mml-to-mime) |
| 5044 | (remove-hook 'kill-buffer-hook | 5046 | (mml-destroy-buffers) |
| 5045 | 'mml-destroy-buffers t) | 5047 | (remove-hook 'kill-buffer-hook |
| 5046 | (kill-local-variable 'mml-buffer-list)) | 5048 | #'mml-destroy-buffers t) |
| 5047 | (gnus-summary-edit-article-done | 5049 | (kill-local-variable 'mml-buffer-list)) |
| 5048 | ,(or (mail-header-references gnus-current-headers) "") | 5050 | (gnus-summary-edit-article-done gch ro buf no-highlight)) |
| 5049 | ,(gnus-group-read-only-p) | 5051 | t)) |
| 5050 | ,gnus-summary-buffer no-highlight)) | ||
| 5051 | t) | ||
| 5052 | ;; Force buttonizing this part. | 5052 | ;; Force buttonizing this part. |
| 5053 | (let ((gnus-mime-buttonized-part-id current-id)) | 5053 | (let ((gnus-mime-buttonized-part-id current-id)) |
| 5054 | (gnus-article-edit-done)) | 5054 | (gnus-article-edit-done)) |
| @@ -5768,10 +5768,11 @@ all parts." | |||
| 5768 | (mm-handle-media-type handle)) | 5768 | (mm-handle-media-type handle)) |
| 5769 | (mm-handle-set-undisplayer | 5769 | (mm-handle-set-undisplayer |
| 5770 | handle | 5770 | handle |
| 5771 | `(lambda () | 5771 | (let ((beg (copy-marker (point-min) t)) |
| 5772 | (let ((inhibit-read-only t)) | 5772 | (end (point-max-marker))) |
| 5773 | (delete-region ,(copy-marker (point-min) t) | 5773 | (lambda () |
| 5774 | ,(point-max-marker))))))) | 5774 | (let ((inhibit-read-only t)) |
| 5775 | (delete-region beg end))))))) | ||
| 5775 | (part | 5776 | (part |
| 5776 | (mm-display-inline handle)))))) | 5777 | (mm-display-inline handle)))))) |
| 5777 | (when (markerp point) | 5778 | (when (markerp point) |
| @@ -7280,12 +7281,13 @@ groups." | |||
| 7280 | (gnus-with-article-buffer | 7281 | (gnus-with-article-buffer |
| 7281 | (article-date-original)) | 7282 | (article-date-original)) |
| 7282 | (gnus-article-edit-article | 7283 | (gnus-article-edit-article |
| 7283 | 'ignore | 7284 | #'ignore |
| 7284 | `(lambda (no-highlight) | 7285 | (let ((gch (or (mail-header-references gnus-current-headers) "")) |
| 7285 | 'ignore | 7286 | (ro (gnus-group-read-only-p)) |
| 7286 | (gnus-summary-edit-article-done | 7287 | (buf gnus-summary-buffer)) |
| 7287 | ,(or (mail-header-references gnus-current-headers) "") | 7288 | (lambda (no-highlight) |
| 7288 | ,(gnus-group-read-only-p) ,gnus-summary-buffer no-highlight)))) | 7289 | 'ignore |
| 7290 | (gnus-summary-edit-article-done gch ro buf no-highlight))))) | ||
| 7289 | 7291 | ||
| 7290 | (defun gnus-article-edit-article (start-func exit-func &optional quiet) | 7292 | (defun gnus-article-edit-article (start-func exit-func &optional quiet) |
| 7291 | "Start editing the contents of the current article buffer." | 7293 | "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 @@ | |||
| 99 | (let ((gnus-verbose-backends nil)) | 99 | (let ((gnus-verbose-backends nil)) |
| 100 | (gnus-request-expire-articles (list article) group t)) | 100 | (gnus-request-expire-articles (list article) group t)) |
| 101 | (push | 101 | (push |
| 102 | `((lambda () | 102 | (let ((buf gnus-summary-buffer)) |
| 103 | (when (gnus-buffer-live-p ,gnus-summary-buffer) | 103 | (lambda () |
| 104 | (with-current-buffer ,gnus-summary-buffer | 104 | (when (gnus-buffer-live-p buf) |
| 105 | (gnus-cache-possibly-remove-article ,article nil nil nil t))))) | 105 | (with-current-buffer buf |
| 106 | (gnus-cache-possibly-remove-article article nil nil nil t))))) | ||
| 106 | message-send-actions))) | 107 | message-send-actions))) |
| 107 | 108 | ||
| 108 | (defun gnus-draft-send-message (&optional n) | 109 | (defun gnus-draft-send-message (&optional n) |
| @@ -274,8 +275,7 @@ If DONT-POP is nil, display the buffer after setting it up." | |||
| 274 | (gnus-configure-posting-styles) | 275 | (gnus-configure-posting-styles) |
| 275 | (setq gnus-message-group-art (cons gnus-newsgroup-name (cadr ga))) | 276 | (setq gnus-message-group-art (cons gnus-newsgroup-name (cadr ga))) |
| 276 | (setq message-post-method | 277 | (setq message-post-method |
| 277 | `(lambda (arg) | 278 | (lambda (arg) (gnus-post-method arg (car ga)))) |
| 278 | (gnus-post-method arg ,(car ga)))) | ||
| 279 | (unless (equal (cadr ga) "") | 279 | (unless (equal (cadr ga) "") |
| 280 | (dolist (article (cdr ga)) | 280 | (dolist (article (cdr ga)) |
| 281 | (message-add-action | 281 | (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." | |||
| 2930 | ((eq part 'params) "group parameters") | 2930 | ((eq part 'params) "group parameters") |
| 2931 | (t "group info")) | 2931 | (t "group info")) |
| 2932 | group) | 2932 | group) |
| 2933 | `(lambda (form) | 2933 | (lambda (form) |
| 2934 | (gnus-group-edit-group-done ',part ,group form))) | 2934 | (gnus-group-edit-group-done part group form))) |
| 2935 | (local-set-key | 2935 | (local-set-key |
| 2936 | "\C-c\C-i" | 2936 | "\C-c\C-i" |
| 2937 | (gnus-create-info-command | 2937 | (gnus-create-info-command |
| @@ -3378,9 +3378,9 @@ Editing the access control list for `%s'. | |||
| 3378 | implementation-defined hierarchy, RENAME or DELETE mailbox) | 3378 | implementation-defined hierarchy, RENAME or DELETE mailbox) |
| 3379 | d - delete messages (STORE \\DELETED flag, perform EXPUNGE) | 3379 | d - delete messages (STORE \\DELETED flag, perform EXPUNGE) |
| 3380 | a - administer (perform SETACL)" group) | 3380 | a - administer (perform SETACL)" group) |
| 3381 | `(lambda (form) | 3381 | (lambda (form) |
| 3382 | (nnimap-acl-edit | 3382 | (nnimap-acl-edit |
| 3383 | ,mailbox ',method ',acl form))))) | 3383 | mailbox method acl form))))) |
| 3384 | 3384 | ||
| 3385 | ;; Group sorting commands | 3385 | ;; Group sorting commands |
| 3386 | ;; Suggested by Joe Hildebrand <hildjj@idaho.fuentez.com>. | 3386 | ;; Suggested by Joe Hildebrand <hildjj@idaho.fuentez.com>. |
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." | |||
| 177 | (add-text-properties | 177 | (add-text-properties |
| 178 | start end | 178 | start end |
| 179 | (list 'image-url url | 179 | (list 'image-url url |
| 180 | 'image-displayer `(lambda (url start end) | 180 | 'image-displayer (lambda (url start end) |
| 181 | (gnus-html-display-image url start end | 181 | (gnus-html-display-image url start end |
| 182 | ,alt-text)) | 182 | alt-text)) |
| 183 | 'help-echo alt-text | 183 | 'help-echo alt-text |
| 184 | 'button t | 184 | 'button t |
| 185 | 'keymap gnus-html-image-map | 185 | '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." | |||
| 606 | (downcase (symbol-name header))) | 606 | (downcase (symbol-name header))) |
| 607 | gnus-extra-headers))) | 607 | gnus-extra-headers))) |
| 608 | (setq function | 608 | (setq function |
| 609 | `(lambda (h) | 609 | (let ((type (nth (- (length gnus-extra-headers) |
| 610 | (gnus-extra-header | 610 | (length extras)) |
| 611 | (quote ,(nth (- (length gnus-extra-headers) | 611 | gnus-extra-headers))) |
| 612 | (length extras)) | 612 | (lambda (h) (gnus-extra-header type h)))))))) |
| 613 | gnus-extra-headers)) | ||
| 614 | h))))))) | ||
| 615 | ;; Signal error. | 613 | ;; Signal error. |
| 616 | (t | 614 | (t |
| 617 | (error "Unknown header field: \"%s\"" field))) | 615 | (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." | |||
| 389 | ;;; Internal functions. | 389 | ;;; Internal functions. |
| 390 | 390 | ||
| 391 | (defun gnus-inews-make-draft (articles) | 391 | (defun gnus-inews-make-draft (articles) |
| 392 | `(lambda () | 392 | (let ((gn gnus-newsgroup-name)) |
| 393 | (gnus-inews-make-draft-meta-information | 393 | (lambda () |
| 394 | ,gnus-newsgroup-name ',articles))) | 394 | (gnus-inews-make-draft-meta-information |
| 395 | gn articles)))) | ||
| 395 | 396 | ||
| 396 | (autoload 'nnselect-article-number "nnselect" nil nil 'macro) | 397 | (autoload 'nnselect-article-number "nnselect" nil nil 'macro) |
| 397 | (autoload 'nnselect-article-group "nnselect" nil nil 'macro) | 398 | (autoload 'nnselect-article-group "nnselect" nil nil 'macro) |
| @@ -578,8 +579,8 @@ instead." | |||
| 578 | (when gnus-agent | 579 | (when gnus-agent |
| 579 | (add-hook 'message-header-hook #'gnus-agent-possibly-save-gcc nil t)) | 580 | (add-hook 'message-header-hook #'gnus-agent-possibly-save-gcc nil t)) |
| 580 | (setq message-post-method | 581 | (setq message-post-method |
| 581 | `(lambda (&optional arg) | 582 | (let ((gn gnus-newsgroup-name)) |
| 582 | (gnus-post-method arg ,gnus-newsgroup-name))) | 583 | (lambda (&optional arg) (gnus-post-method arg gn)))) |
| 583 | (message-add-action | 584 | (message-add-action |
| 584 | `(progn | 585 | `(progn |
| 585 | (setq gnus-current-window-configuration ',winconf-name) | 586 | (setq gnus-current-window-configuration ',winconf-name) |
| @@ -820,8 +821,8 @@ prefix `a', cancel using the standard posting method; if not | |||
| 820 | post using the current select method." | 821 | post using the current select method." |
| 821 | (interactive (gnus-interactive "P\ny")) | 822 | (interactive (gnus-interactive "P\ny")) |
| 822 | (let ((message-post-method | 823 | (let ((message-post-method |
| 823 | `(lambda (arg) | 824 | (let ((gn gnus-newsgroup-name)) |
| 824 | (gnus-post-method (eq ',symp 'a) ,gnus-newsgroup-name))) | 825 | (lambda (_arg) (gnus-post-method (eq symp 'a) gn)))) |
| 825 | (custom-address user-mail-address)) | 826 | (custom-address user-mail-address)) |
| 826 | (dolist (article (gnus-summary-work-articles n)) | 827 | (dolist (article (gnus-summary-work-articles n)) |
| 827 | (when (gnus-summary-select-article t nil nil article) | 828 | (when (gnus-summary-select-article t nil nil article) |
| @@ -856,11 +857,12 @@ header line with the old Message-ID." | |||
| 856 | (set-buffer gnus-original-article-buffer) | 857 | (set-buffer gnus-original-article-buffer) |
| 857 | (message-supersede) | 858 | (message-supersede) |
| 858 | (push | 859 | (push |
| 859 | `((lambda () | 860 | (let ((buf gnus-summary-buffer)) |
| 860 | (when (gnus-buffer-live-p ,gnus-summary-buffer) | 861 | (lambda () |
| 861 | (with-current-buffer ,gnus-summary-buffer | 862 | (when (gnus-buffer-live-p buf) |
| 862 | (gnus-cache-possibly-remove-article ,article nil nil nil t) | 863 | (with-current-buffer buf |
| 863 | (gnus-summary-mark-as-read ,article gnus-canceled-mark))))) | 864 | (gnus-cache-possibly-remove-article article nil nil nil t) |
| 865 | (gnus-summary-mark-as-read article gnus-canceled-mark))))) | ||
| 864 | message-send-actions) | 866 | message-send-actions) |
| 865 | ;; Add Gcc header. | 867 | ;; Add Gcc header. |
| 866 | (gnus-inews-insert-gcc)))) | 868 | (gnus-inews-insert-gcc)))) |
| @@ -1387,11 +1389,12 @@ the message before resending." | |||
| 1387 | (add-hook 'message-header-setup-hook | 1389 | (add-hook 'message-header-setup-hook |
| 1388 | #'gnus-summary-resend-message-insert-gcc t) | 1390 | #'gnus-summary-resend-message-insert-gcc t) |
| 1389 | (add-hook 'message-sent-hook | 1391 | (add-hook 'message-sent-hook |
| 1390 | `(lambda () | 1392 | (let ((agent gnus-agent)) |
| 1391 | (let ((rfc2047-encode-encoded-words nil)) | 1393 | (lambda () |
| 1392 | ,(if gnus-agent | 1394 | (let ((rfc2047-encode-encoded-words nil)) |
| 1393 | '(gnus-agent-possibly-do-gcc) | 1395 | (if agent |
| 1394 | '(gnus-inews-do-gcc))))) | 1396 | (gnus-agent-possibly-do-gcc) |
| 1397 | (gnus-inews-do-gcc)))))) | ||
| 1395 | (dolist (article (gnus-summary-work-articles n)) | 1398 | (dolist (article (gnus-summary-work-articles n)) |
| 1396 | (if no-select | 1399 | (if no-select |
| 1397 | (with-current-buffer " *nntpd*" | 1400 | (with-current-buffer " *nntpd*" |
| @@ -1916,47 +1919,49 @@ this is a reply." | |||
| 1916 | ((eq 'eval (car result)) | 1919 | ((eq 'eval (car result)) |
| 1917 | #'ignore) | 1920 | #'ignore) |
| 1918 | ((eq 'body (car result)) | 1921 | ((eq 'body (car result)) |
| 1919 | `(lambda () | 1922 | (let ((txt (cdr result))) |
| 1920 | (save-excursion | 1923 | (lambda () |
| 1921 | (message-goto-body) | 1924 | (save-excursion |
| 1922 | (insert ,(cdr result))))) | 1925 | (message-goto-body) |
| 1926 | (insert txt))))) | ||
| 1923 | ((eq 'signature (car result)) | 1927 | ((eq 'signature (car result)) |
| 1924 | (setq-local message-signature nil) | 1928 | (setq-local message-signature nil) |
| 1925 | (setq-local message-signature-file nil) | 1929 | (setq-local message-signature-file nil) |
| 1926 | (if (not (cdr result)) | 1930 | (let ((txt (cdr result))) |
| 1927 | #'ignore | 1931 | (if (not txt) |
| 1928 | `(lambda () | 1932 | #'ignore |
| 1929 | (save-excursion | 1933 | (lambda () |
| 1930 | (let ((message-signature ,(cdr result))) | 1934 | (save-excursion |
| 1931 | (when message-signature | 1935 | (let ((message-signature txt)) |
| 1932 | (message-insert-signature))))))) | 1936 | (when message-signature |
| 1937 | (message-insert-signature)))))))) | ||
| 1933 | (t | 1938 | (t |
| 1934 | (let ((header | 1939 | (let ((header |
| 1935 | (if (symbolp (car result)) | 1940 | (if (symbolp (car result)) |
| 1936 | (capitalize (symbol-name (car result))) | 1941 | (capitalize (symbol-name (car result))) |
| 1937 | (car result)))) | 1942 | (car result))) |
| 1938 | `(lambda () | 1943 | (value (cdr result))) |
| 1939 | (save-excursion | 1944 | (lambda () |
| 1940 | (message-remove-header ,header) | 1945 | (save-excursion |
| 1941 | (let ((value ,(cdr result))) | 1946 | (message-remove-header header) |
| 1942 | (when value | 1947 | (when value |
| 1943 | (message-goto-eoh) | 1948 | (message-goto-eoh) |
| 1944 | (insert ,header ": " value) | 1949 | (insert header ": " value) |
| 1945 | (unless (bolp) | 1950 | (unless (bolp) |
| 1946 | (insert "\n"))))))))) | 1951 | (insert "\n")))))))) |
| 1947 | nil 'local)) | 1952 | nil 'local)) |
| 1948 | (when (or name address) | 1953 | (when (or name address) |
| 1949 | (add-hook 'message-setup-hook | 1954 | (add-hook 'message-setup-hook |
| 1950 | `(lambda () | 1955 | (let ((name (or (cdr name) (user-full-name))) |
| 1951 | (setq-local user-mail-address | 1956 | (email (or (cdr address) user-mail-address))) |
| 1952 | ,(or (cdr address) user-mail-address)) | 1957 | (lambda () |
| 1953 | (let ((user-full-name ,(or (cdr name) (user-full-name))) | 1958 | (setq-local user-mail-address email) |
| 1954 | (user-mail-address | 1959 | (let ((user-full-name name) |
| 1955 | ,(or (cdr address) user-mail-address))) | 1960 | (user-mail-address email)) |
| 1956 | (save-excursion | 1961 | (save-excursion |
| 1957 | (message-remove-header "From") | 1962 | (message-remove-header "From") |
| 1958 | (message-goto-eoh) | 1963 | (message-goto-eoh) |
| 1959 | (insert "From: " (message-make-from) "\n")))) | 1964 | (insert "From: " (message-make-from) "\n"))))) |
| 1960 | nil 'local))))) | 1965 | nil 'local))))) |
| 1961 | 1966 | ||
| 1962 | (defun gnus-summary-attach-article (n) | 1967 | (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: | |||
| 612 | (gnus-close-server info) | 612 | (gnus-close-server info) |
| 613 | (gnus-edit-form | 613 | (gnus-edit-form |
| 614 | info "Editing the server." | 614 | info "Editing the server." |
| 615 | `(lambda (form) | 615 | (lambda (form) |
| 616 | (gnus-server-set-info ,server form) | 616 | (gnus-server-set-info server form) |
| 617 | (gnus-server-list-servers) | 617 | (gnus-server-list-servers) |
| 618 | (gnus-server-position-point)) | 618 | (gnus-server-position-point)) |
| 619 | 'edit-server))) | 619 | 'edit-server))) |
| 620 | 620 | ||
| 621 | (defun gnus-server-show-server (server) | 621 | (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." | |||
| 10676 | (setq mml-buffer-list mbl) | 10676 | (setq mml-buffer-list mbl) |
| 10677 | (setq-local mml-buffer-list mbl1)) | 10677 | (setq-local mml-buffer-list mbl1)) |
| 10678 | (add-hook 'kill-buffer-hook #'mml-destroy-buffers t t)))) | 10678 | (add-hook 'kill-buffer-hook #'mml-destroy-buffers t t)))) |
| 10679 | `(lambda (no-highlight) | 10679 | (let ((charset gnus-newsgroup-charset) |
| 10680 | (let ((mail-parse-charset ',gnus-newsgroup-charset) | 10680 | (ign-cs gnus-newsgroup-ignored-charsets) |
| 10681 | (message-options message-options) | 10681 | (hea (let ((charset (gnus-group-name-charset |
| 10682 | (message-options-set-recipient) | 10682 | (gnus-find-method-for-group |
| 10683 | (mail-parse-ignored-charsets | 10683 | gnus-newsgroup-name) |
| 10684 | ',gnus-newsgroup-ignored-charsets) | 10684 | gnus-newsgroup-name))) |
| 10685 | (rfc2047-header-encoding-alist | 10685 | (append (list (cons "Newsgroups" charset) |
| 10686 | ',(let ((charset (gnus-group-name-charset | 10686 | (cons "Followup-To" charset) |
| 10687 | (gnus-find-method-for-group | 10687 | (cons "Xref" charset)) |
| 10688 | gnus-newsgroup-name) | 10688 | rfc2047-header-encoding-alist))) |
| 10689 | gnus-newsgroup-name))) | 10689 | (gch (or (mail-header-references gnus-current-headers) "")) |
| 10690 | (append (list (cons "Newsgroups" charset) | 10690 | (ro (gnus-group-read-only-p)) |
| 10691 | (cons "Followup-To" charset) | 10691 | (buf gnus-summary-buffer)) |
| 10692 | (cons "Xref" charset)) | 10692 | (lambda (no-highlight) |
| 10693 | rfc2047-header-encoding-alist)))) | 10693 | (let ((mail-parse-charset charset) |
| 10694 | ,(if (not raw) '(progn | 10694 | (message-options message-options) |
| 10695 | (mml-to-mime) | 10695 | (message-options-set-recipient) |
| 10696 | (mml-destroy-buffers) | 10696 | (mail-parse-ignored-charsets ign-cs) |
| 10697 | (remove-hook 'kill-buffer-hook | 10697 | (rfc2047-header-encoding-alist hea)) |
| 10698 | #'mml-destroy-buffers t) | 10698 | (unless raw |
| 10699 | (kill-local-variable 'mml-buffer-list))) | 10699 | (mml-to-mime) |
| 10700 | (gnus-summary-edit-article-done | 10700 | (mml-destroy-buffers) |
| 10701 | ,(or (mail-header-references gnus-current-headers) "") | 10701 | (remove-hook 'kill-buffer-hook |
| 10702 | ,(gnus-group-read-only-p) | 10702 | #'mml-destroy-buffers t) |
| 10703 | ,gnus-summary-buffer no-highlight)))))))) | 10703 | (kill-local-variable 'mml-buffer-list)) |
| 10704 | (gnus-summary-edit-article-done gch ro buf no-highlight))))))))) | ||
| 10704 | 10705 | ||
| 10705 | (defalias 'gnus-summary-edit-article-postpone 'gnus-article-edit-exit) | 10706 | (defalias 'gnus-summary-edit-article-postpone 'gnus-article-edit-exit) |
| 10706 | 10707 | ||
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." | |||
| 1608 | (gnus-topic-parameters topic) | 1608 | (gnus-topic-parameters topic) |
| 1609 | (format-message "Editing the topic parameters for `%s'." | 1609 | (format-message "Editing the topic parameters for `%s'." |
| 1610 | (or group topic)) | 1610 | (or group topic)) |
| 1611 | `(lambda (form) | 1611 | (lambda (form) |
| 1612 | (gnus-topic-set-parameters ,topic form))))))) | 1612 | (gnus-topic-set-parameters topic form))))))) |
| 1613 | 1613 | ||
| 1614 | (defun gnus-group-sort-topic (func reverse) | 1614 | (defun gnus-group-sort-topic (func reverse) |
| 1615 | "Sort groups in the topics according to FUNC and REVERSE." | 1615 | "Sort groups in the topics according to FUNC and REVERSE." |
| @@ -1693,9 +1693,8 @@ If REVERSE, sort in reverse order." | |||
| 1693 | (defun gnus-topic-sort-topics-1 (top reverse) | 1693 | (defun gnus-topic-sort-topics-1 (top reverse) |
| 1694 | (if (cdr top) | 1694 | (if (cdr top) |
| 1695 | (let ((subtop | 1695 | (let ((subtop |
| 1696 | (mapcar (gnus-byte-compile | 1696 | (mapcar (lambda (top) |
| 1697 | `(lambda (top) | 1697 | (gnus-topic-sort-topics-1 top reverse)) |
| 1698 | (gnus-topic-sort-topics-1 top ,reverse))) | ||
| 1699 | (sort (cdr top) | 1698 | (sort (cdr top) |
| 1700 | (lambda (t1 t2) | 1699 | (lambda (t1 t2) |
| 1701 | (string-lessp (caar t1) (caar t2))))))) | 1700 | (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'." | |||
| 1234 | (cons (cons key value) (gnus-remassoc key alist)) | 1234 | (cons (cons key value) (gnus-remassoc key alist)) |
| 1235 | (gnus-remassoc key alist))) | 1235 | (gnus-remassoc key alist))) |
| 1236 | 1236 | ||
| 1237 | (defvar gnus-info-buffer) | ||
| 1238 | (declare-function gnus-configure-windows "gnus-win" (setting &optional force)) | ||
| 1239 | |||
| 1237 | (defun gnus-create-info-command (node) | 1240 | (defun gnus-create-info-command (node) |
| 1238 | "Create a command that will go to info NODE." | 1241 | "Create a command that will go to info NODE." |
| 1239 | `(lambda () | 1242 | (lambda () |
| 1240 | (interactive) | 1243 | (:documentation (format "Enter the info system at node %s." node)) |
| 1241 | ,(concat "Enter the info system at node " node) | 1244 | (interactive) |
| 1242 | (Info-goto-node ,node) | 1245 | (info node) |
| 1243 | (setq gnus-info-buffer (current-buffer)) | 1246 | (setq gnus-info-buffer (current-buffer)) |
| 1244 | (gnus-configure-windows 'info))) | 1247 | (gnus-configure-windows 'info))) |
| 1245 | 1248 | ||
| 1246 | (defun gnus-not-ignore (&rest _args) | 1249 | (defun gnus-not-ignore (&rest _args) |
| 1247 | t) | 1250 | 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 @@ | |||
| 100 | (goto-char (point-max)) | 100 | (goto-char (point-max)) |
| 101 | (mm-handle-set-undisplayer | 101 | (mm-handle-set-undisplayer |
| 102 | handle | 102 | handle |
| 103 | `(lambda () | 103 | (let ((end (point-marker))) |
| 104 | (let ((inhibit-read-only t) | 104 | (lambda () |
| 105 | (end ,(point-marker))) | 105 | (let ((inhibit-read-only t)) |
| 106 | (remove-images ,start end) | 106 | (remove-images start end) |
| 107 | (delete-region ,start end))))))) | 107 | (delete-region start end)))))))) |
| 108 | 108 | ||
| 109 | (provide 'mm-archive) | 109 | (provide 'mm-archive) |
| 110 | 110 | ||
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." | |||
| 135 | (mm-merge-handles gnus-article-mime-handles handles))) | 135 | (mm-merge-handles gnus-article-mime-handles handles))) |
| 136 | (mm-handle-set-undisplayer | 136 | (mm-handle-set-undisplayer |
| 137 | handle | 137 | handle |
| 138 | `(lambda () | 138 | (let ((beg (point-min-marker)) |
| 139 | (let (buffer-read-only) | 139 | (end (point-max-marker))) |
| 140 | (delete-region ,(point-min-marker) ,(point-max-marker)))))))))) | 140 | (lambda () |
| 141 | (let ((inhibit-read-only t)) | ||
| 142 | (delete-region beg end)))))))))) | ||
| 141 | 143 | ||
| 142 | (provide 'mm-partial) | 144 | (provide 'mm-partial) |
| 143 | 145 | ||
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 | |||
| 104 | (insert "\n") | 104 | (insert "\n") |
| 105 | (mm-handle-set-undisplayer | 105 | (mm-handle-set-undisplayer |
| 106 | handle | 106 | handle |
| 107 | `(lambda () | 107 | (lambda () |
| 108 | (let ((b ,b) | 108 | (let ((inhibit-read-only t)) |
| 109 | (inhibit-read-only t)) | 109 | (remove-images b b) |
| 110 | (remove-images b b) | 110 | (delete-region b (1+ b))))))) |
| 111 | (delete-region b (1+ b))))))) | ||
| 112 | 111 | ||
| 113 | (defvar mm-w3m-setup nil | 112 | (defvar mm-w3m-setup nil |
| 114 | "Whether gnus-article-mode has been setup to use emacs-w3m.") | 113 | "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 | |||
| 202 | 'keymap w3m-minor-mode-map))) | 201 | 'keymap w3m-minor-mode-map))) |
| 203 | (mm-handle-set-undisplayer | 202 | (mm-handle-set-undisplayer |
| 204 | handle | 203 | handle |
| 205 | `(lambda () | 204 | (let ((beg (point-min-marker)) |
| 206 | (let ((inhibit-read-only t)) | 205 | (end (point-max-marker))) |
| 207 | (delete-region ,(point-min-marker) | 206 | (lambda () |
| 208 | ,(point-max-marker))))))))) | 207 | (let ((inhibit-read-only t)) |
| 208 | (delete-region beg end))))))))) | ||
| 209 | 209 | ||
| 210 | (defcustom mm-w3m-standalone-supports-m17n-p 'undecided | 210 | (defcustom mm-w3m-standalone-supports-m17n-p 'undecided |
| 211 | "T means the w3m command supports the m17n feature." | 211 | "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 | |||
| 381 | handle | 381 | handle |
| 382 | (if (= (point-min) (point-max)) | 382 | (if (= (point-min) (point-max)) |
| 383 | #'ignore | 383 | #'ignore |
| 384 | `(lambda () | 384 | (let ((beg (copy-marker (point-min) t)) |
| 385 | (let ((inhibit-read-only t)) | 385 | (end (point-max-marker))) |
| 386 | (delete-region ,(copy-marker (point-min) t) | 386 | (lambda () |
| 387 | ,(point-max-marker))))))))) | 387 | (let ((inhibit-read-only t)) |
| 388 | (delete-region beg end))))))))) | ||
| 388 | 389 | ||
| 389 | (defun mm-insert-inline (handle text) | 390 | (defun mm-insert-inline (handle text) |
| 390 | "Insert TEXT inline from HANDLE." | 391 | "Insert TEXT inline from HANDLE." |
| @@ -394,10 +395,11 @@ This is only used if `mm-inline-large-images' is set to | |||
| 394 | (insert "\n")) | 395 | (insert "\n")) |
| 395 | (mm-handle-set-undisplayer | 396 | (mm-handle-set-undisplayer |
| 396 | handle | 397 | handle |
| 397 | `(lambda () | 398 | (let ((beg (copy-marker b t)) |
| 398 | (let ((inhibit-read-only t)) | 399 | (end (point-marker))) |
| 399 | (delete-region ,(copy-marker b t) | 400 | (lambda () |
| 400 | ,(point-marker))))))) | 401 | (let ((inhibit-read-only t)) |
| 402 | (delete-region beg end))))))) | ||
| 401 | 403 | ||
| 402 | (defun mm-inline-audio (_handle) | 404 | (defun mm-inline-audio (_handle) |
| 403 | (message "Not implemented")) | 405 | (message "Not implemented")) |
| @@ -457,9 +459,11 @@ This is only used if `mm-inline-large-images' is set to | |||
| 457 | (mm-merge-handles gnus-article-mime-handles handles))) | 459 | (mm-merge-handles gnus-article-mime-handles handles))) |
| 458 | (mm-handle-set-undisplayer | 460 | (mm-handle-set-undisplayer |
| 459 | handle | 461 | handle |
| 460 | `(lambda () | 462 | (let ((beg (point-min-marker)) |
| 461 | (let ((inhibit-read-only t)) | 463 | (end (point-max-marker))) |
| 462 | (delete-region ,(point-min-marker) ,(point-max-marker))))))))) | 464 | (lambda () |
| 465 | (let ((inhibit-read-only t)) | ||
| 466 | (delete-region beg end))))))))) | ||
| 463 | 467 | ||
| 464 | ;; Shut up byte-compiler. | 468 | ;; Shut up byte-compiler. |
| 465 | (defvar font-lock-mode-hook) | 469 | (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." | |||
| 1783 | (assq 'directory mail-sources))) | 1783 | (assq 'directory mail-sources))) |
| 1784 | 1784 | ||
| 1785 | (defun nnmail-get-new-mail-1 (method exit-func temp | 1785 | (defun nnmail-get-new-mail-1 (method exit-func temp |
| 1786 | group _in-group spool-func) | 1786 | group in-group spool-func) |
| 1787 | (let* ((sources mail-sources) | 1787 | (let* ((sources mail-sources) |
| 1788 | fetching-sources | 1788 | fetching-sources |
| 1789 | (i 0) | 1789 | (i 0) |
| @@ -1812,10 +1812,10 @@ be called once per group or once for all groups." | |||
| 1812 | (setq source (append source | 1812 | (setq source (append source |
| 1813 | (list | 1813 | (list |
| 1814 | :predicate | 1814 | :predicate |
| 1815 | (gnus-byte-compile | 1815 | (let ((str (concat group suffix))) |
| 1816 | `(lambda (file) | 1816 | (lambda (file) |
| 1817 | (string-equal | 1817 | (string-equal |
| 1818 | ,(concat group suffix) | 1818 | str |
| 1819 | (file-name-nondirectory file))))))))) | 1819 | (file-name-nondirectory file))))))))) |
| 1820 | (when nnmail-fetched-sources | 1820 | (when nnmail-fetched-sources |
| 1821 | (if (member source nnmail-fetched-sources) | 1821 | (if (member source nnmail-fetched-sources) |
| @@ -1836,17 +1836,19 @@ be called once per group or once for all groups." | |||
| 1836 | (condition-case cond | 1836 | (condition-case cond |
| 1837 | (mail-source-fetch | 1837 | (mail-source-fetch |
| 1838 | source | 1838 | source |
| 1839 | (gnus-byte-compile | 1839 | (let ((smsym (intern (format "%s-save-mail" method))) |
| 1840 | `(lambda (file orig-file) | 1840 | (ansym (intern (format "%s-active-number" method))) |
| 1841 | (src source)) | ||
| 1842 | (lambda (file orig-file) | ||
| 1841 | (nnmail-split-incoming | 1843 | (nnmail-split-incoming |
| 1842 | file ',(intern (format "%s-save-mail" method)) | 1844 | file smsym |
| 1843 | ',spool-func | 1845 | spool-func |
| 1844 | (or in-group | 1846 | (or in-group |
| 1845 | (if (equal file orig-file) | 1847 | (if (equal file orig-file) |
| 1846 | nil | 1848 | nil |
| 1847 | (nnmail-get-split-group orig-file | 1849 | (nnmail-get-split-group orig-file |
| 1848 | ',source))) | 1850 | src))) |
| 1849 | ',(intern (format "%s-active-number" method)))))) | 1851 | ansym)))) |
| 1850 | ((error quit) | 1852 | ((error quit) |
| 1851 | (message "Mail source %s failed: %s" source cond) | 1853 | (message "Mail source %s failed: %s" source cond) |
| 1852 | 0))) | 1854 | 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.") | |||
| 701 | (setf (gnus-info-read info) | 701 | (setf (gnus-info-read info) |
| 702 | (if docorr | 702 | (if docorr |
| 703 | (nnmairix-map-range | 703 | (nnmairix-map-range |
| 704 | ;; FIXME: Use lexical-binding. | 704 | (let ((off (cadr corr))) |
| 705 | `(lambda (x) (+ x ,(cadr corr))) | 705 | (lambda (x) (+ x off))) |
| 706 | (gnus-info-read folderinfo)) | 706 | (gnus-info-read folderinfo)) |
| 707 | (gnus-info-read folderinfo))) | 707 | (gnus-info-read folderinfo))) |
| 708 | ;; set other marks | 708 | ;; set other marks |
| @@ -712,8 +712,8 @@ Other back ends might or might not work.") | |||
| 712 | (cons | 712 | (cons |
| 713 | (car cur) | 713 | (car cur) |
| 714 | (nnmairix-map-range | 714 | (nnmairix-map-range |
| 715 | ;; FIXME: Use lexical-binding. | 715 | (let ((off (cadr corr))) |
| 716 | `(lambda (x) (+ x ,(cadr corr))) | 716 | (lambda (x) (+ x off))) |
| 717 | (list (cadr cur))))) | 717 | (list (cadr cur))))) |
| 718 | (gnus-info-marks folderinfo)) | 718 | (gnus-info-marks folderinfo)) |
| 719 | (gnus-info-marks folderinfo)))) | 719 | (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.") | |||
| 411 | (and | 411 | (and |
| 412 | (nnmail-activate 'nnml) | 412 | (nnmail-activate 'nnml) |
| 413 | (if (and (not (setq result (nnmail-article-group | 413 | (if (and (not (setq result (nnmail-article-group |
| 414 | `(lambda (group) | 414 | (lambda (group) |
| 415 | (nnml-active-number group ,server))))) | 415 | (nnml-active-number group server))))) |
| 416 | (yes-or-no-p "Moved to `junk' group; delete article? ")) | 416 | (yes-or-no-p "Moved to `junk' group; delete article? ")) |
| 417 | (setq result 'junk) | 417 | (setq result 'junk) |
| 418 | (setq result (car (nnml-save-mail result server t)))) | 418 | (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 @@ | |||
| 49 | (defun ,func ,args ,@forms) | 49 | (defun ,func ,args ,@forms) |
| 50 | (nnoo-register-function ',func))) | 50 | (nnoo-register-function ',func))) |
| 51 | 51 | ||
| 52 | (defun noo--defalias (fun val) | ||
| 53 | (prog1 (defalias fun val) (nnoo-register-function fun))) | ||
| 54 | |||
| 52 | (defun nnoo-register-function (func) | 55 | (defun nnoo-register-function (func) |
| 53 | (let ((funcs (nthcdr 3 (assoc (nnoo-backend func) | 56 | (let ((funcs (nthcdr 3 (assoc (nnoo-backend func) |
| 54 | nnoo-definition-alist)))) | 57 | nnoo-definition-alist)))) |
| @@ -90,9 +93,9 @@ | |||
| 90 | (dolist (fun (or (cdr imp) (nnoo-functions (car imp)))) | 93 | (dolist (fun (or (cdr imp) (nnoo-functions (car imp)))) |
| 91 | (let ((function (nnoo-symbol backend (nnoo-rest-symbol fun)))) | 94 | (let ((function (nnoo-symbol backend (nnoo-rest-symbol fun)))) |
| 92 | (unless (fboundp function) | 95 | (unless (fboundp function) |
| 93 | ;; FIXME: Use `defalias' and closures to avoid `eval'. | 96 | (noo--defalias function |
| 94 | (eval `(deffoo ,function (&rest args) | 97 | (lambda (&rest args) |
| 95 | (,call-function ',backend ',fun args))))))))) | 98 | (funcall call-function backend fun args))))))))) |
| 96 | 99 | ||
| 97 | (defun nnoo-parent-function (backend function args) | 100 | (defun nnoo-parent-function (backend function args) |
| 98 | (let ((pbackend (nnoo-backend function)) | 101 | (let ((pbackend (nnoo-backend function)) |
| @@ -301,11 +304,9 @@ All functions will return nil and report an error." | |||
| 301 | request-list request-post request-list-newsgroups)) | 304 | request-list request-post request-list-newsgroups)) |
| 302 | (let ((fun (nnoo-symbol backend op))) | 305 | (let ((fun (nnoo-symbol backend op))) |
| 303 | (unless (fboundp fun) | 306 | (unless (fboundp fun) |
| 304 | ;; FIXME: Use `defalias' and closures to avoid `eval'. | 307 | (let ((msg (format "%s-%s not implemented" backend op))) |
| 305 | (eval `(deffoo ,fun | 308 | (noo--defalias fun |
| 306 | (&rest _args) | 309 | (lambda (&rest _args) (nnheader-report backend msg)))))))) |
| 307 | (nnheader-report ',backend ,(format "%s-%s not implemented" | ||
| 308 | backend op)))))))) | ||
| 309 | 310 | ||
| 310 | (defun nnoo-set (server &rest args) | 311 | (defun nnoo-set (server &rest args) |
| 311 | (let ((parents (nnoo-parents (car server))) | 312 | (let ((parents (nnoo-parents (car server))) |