diff options
| author | Stefan Monnier | 2019-06-26 10:03:48 -0400 |
|---|---|---|
| committer | Stefan Monnier | 2019-06-26 10:03:48 -0400 |
| commit | 698ff554ac2699ec48fefc85a1307cbc4a183b0d (patch) | |
| tree | a7b7592f7973f81cad4410366d313e790616907e /lisp/gnus | |
| parent | 9233865b7005831e63755eb84ae7da060f878a55 (diff) | |
| download | emacs-698ff554ac2699ec48fefc85a1307cbc4a183b0d.tar.gz emacs-698ff554ac2699ec48fefc85a1307cbc4a183b0d.zip | |
* lisp/calc/calc-ext.el (math-scalarp): Fix typo
Diffstat (limited to 'lisp/gnus')
| -rw-r--r-- | lisp/gnus/gnus-art.el | 284 | ||||
| -rw-r--r-- | lisp/gnus/gnus-cloud.el | 10 | ||||
| -rw-r--r-- | lisp/gnus/gnus-topic.el | 9 | ||||
| -rw-r--r-- | lisp/gnus/gnus-util.el | 114 | ||||
| -rw-r--r-- | lisp/gnus/nnimap.el | 2 |
5 files changed, 208 insertions, 211 deletions
diff --git a/lisp/gnus/gnus-art.el b/lisp/gnus/gnus-art.el index d826faca5bd..6b5a21eaf55 100644 --- a/lisp/gnus/gnus-art.el +++ b/lisp/gnus/gnus-art.el | |||
| @@ -1615,7 +1615,7 @@ It is a string, such as \"PGP\". If nil, ask user." | |||
| 1615 | :group 'gnus-article | 1615 | :group 'gnus-article |
| 1616 | :type 'boolean) | 1616 | :type 'boolean) |
| 1617 | 1617 | ||
| 1618 | (defcustom gnus-blocked-images 'gnus-block-private-groups | 1618 | (defcustom gnus-blocked-images #'gnus-block-private-groups |
| 1619 | "Images that have URLs matching this regexp will be blocked. | 1619 | "Images that have URLs matching this regexp will be blocked. |
| 1620 | Note that the main reason external images are included in HTML | 1620 | Note that the main reason external images are included in HTML |
| 1621 | emails (these days) is to allow tracking whether you've read the | 1621 | emails (these days) is to allow tracking whether you've read the |
| @@ -2693,7 +2693,7 @@ If READ-CHARSET, ask for a coding system." | |||
| 2693 | "Format an HTML article." | 2693 | "Format an HTML article." |
| 2694 | (interactive) | 2694 | (interactive) |
| 2695 | (let ((handles nil) | 2695 | (let ((handles nil) |
| 2696 | (buffer-read-only nil)) | 2696 | (inhibit-read-only t)) |
| 2697 | (when (gnus-buffer-live-p gnus-original-article-buffer) | 2697 | (when (gnus-buffer-live-p gnus-original-article-buffer) |
| 2698 | (with-current-buffer gnus-original-article-buffer | 2698 | (with-current-buffer gnus-original-article-buffer |
| 2699 | (setq handles (mm-dissect-buffer t t)))) | 2699 | (setq handles (mm-dissect-buffer t t)))) |
| @@ -4302,71 +4302,67 @@ If variable `gnus-use-long-file-name' is non-nil, it is | |||
| 4302 | (canlock-verify gnus-original-article-buffer))) | 4302 | (canlock-verify gnus-original-article-buffer))) |
| 4303 | 4303 | ||
| 4304 | (eval-and-compile | 4304 | (eval-and-compile |
| 4305 | (mapc | 4305 | (defmacro gnus-art-defun (gnus-fun &optional article-fun) |
| 4306 | (lambda (func) | 4306 | "Define GNUS-FUN as a function that runs ARTICLE-FUN in the article buffer." |
| 4307 | (let (afunc gfunc) | 4307 | (unless article-fun |
| 4308 | (if (consp func) | 4308 | (if (not (string-match "\\`gnus-" (symbol-name gnus-fun))) |
| 4309 | (setq afunc (car func) | 4309 | (error "Can't guess article-fun argument") |
| 4310 | gfunc (cdr func)) | 4310 | (setq article-fun (intern (substring (symbol-name gnus-fun) |
| 4311 | (setq afunc func | 4311 | (match-end 0)))))) |
| 4312 | gfunc (intern (format "gnus-%s" func)))) | 4312 | `(defun ,gnus-fun (&optional interactive &rest args) |
| 4313 | (defalias gfunc | 4313 | ,(format "Run `%s' in the article buffer." article-fun) |
| 4314 | (when (fboundp afunc) | 4314 | (interactive (list t)) |
| 4315 | `(lambda (&optional interactive &rest args) | 4315 | (with-current-buffer gnus-article-buffer |
| 4316 | ,(documentation afunc t) | 4316 | (if interactive |
| 4317 | (interactive (list t)) | 4317 | (call-interactively ',article-fun) |
| 4318 | (with-current-buffer gnus-article-buffer | 4318 | (apply #',article-fun args)))))) |
| 4319 | (if interactive | 4319 | (gnus-art-defun gnus-article-hide-headers) |
| 4320 | (call-interactively ',afunc) | 4320 | (gnus-art-defun gnus-article-verify-x-pgp-sig) |
| 4321 | (apply #',afunc args)))))))) | 4321 | (gnus-art-defun gnus-article-verify-cancel-lock) |
| 4322 | '(article-hide-headers | 4322 | (gnus-art-defun gnus-article-hide-boring-headers) |
| 4323 | article-verify-x-pgp-sig | 4323 | (gnus-art-defun gnus-article-treat-overstrike) |
| 4324 | article-verify-cancel-lock | 4324 | (gnus-art-defun gnus-article-treat-ansi-sequences) |
| 4325 | article-hide-boring-headers | 4325 | (gnus-art-defun gnus-article-fill-long-lines) |
| 4326 | article-treat-overstrike | 4326 | (gnus-art-defun gnus-article-capitalize-sentences) |
| 4327 | article-treat-ansi-sequences | 4327 | (gnus-art-defun gnus-article-remove-cr) |
| 4328 | article-fill-long-lines | 4328 | (gnus-art-defun gnus-article-remove-leading-whitespace) |
| 4329 | article-capitalize-sentences | 4329 | (gnus-art-defun gnus-article-display-x-face) |
| 4330 | article-remove-cr | 4330 | (gnus-art-defun gnus-article-display-face) |
| 4331 | article-remove-leading-whitespace | 4331 | (gnus-art-defun gnus-article-de-quoted-unreadable) |
| 4332 | article-display-x-face | 4332 | (gnus-art-defun gnus-article-de-base64-unreadable) |
| 4333 | article-display-face | 4333 | (gnus-art-defun gnus-article-decode-HZ) |
| 4334 | article-de-quoted-unreadable | 4334 | (gnus-art-defun gnus-article-wash-html) |
| 4335 | article-de-base64-unreadable | 4335 | (gnus-art-defun gnus-article-unsplit-urls) |
| 4336 | article-decode-HZ | 4336 | (gnus-art-defun gnus-article-hide-list-identifiers) |
| 4337 | article-wash-html | 4337 | (gnus-art-defun gnus-article-strip-banner) |
| 4338 | article-unsplit-urls | 4338 | (gnus-art-defun gnus-article-babel) |
| 4339 | article-hide-list-identifiers | 4339 | (gnus-art-defun gnus-article-hide-pem) |
| 4340 | article-strip-banner | 4340 | (gnus-art-defun gnus-article-hide-signature) |
| 4341 | article-babel | 4341 | (gnus-art-defun gnus-article-strip-headers-in-body) |
| 4342 | article-hide-pem | 4342 | (gnus-art-defun gnus-article-remove-trailing-blank-lines) |
| 4343 | article-hide-signature | 4343 | (gnus-art-defun gnus-article-strip-leading-blank-lines) |
| 4344 | article-strip-headers-in-body | 4344 | (gnus-art-defun gnus-article-strip-multiple-blank-lines) |
| 4345 | article-remove-trailing-blank-lines | 4345 | (gnus-art-defun gnus-article-strip-leading-space) |
| 4346 | article-strip-leading-blank-lines | 4346 | (gnus-art-defun gnus-article-strip-trailing-space) |
| 4347 | article-strip-multiple-blank-lines | 4347 | (gnus-art-defun gnus-article-strip-blank-lines) |
| 4348 | article-strip-leading-space | 4348 | (gnus-art-defun gnus-article-strip-all-blank-lines) |
| 4349 | article-strip-trailing-space | 4349 | (gnus-art-defun gnus-article-date-local) |
| 4350 | article-strip-blank-lines | 4350 | (gnus-art-defun gnus-article-date-english) |
| 4351 | article-strip-all-blank-lines | 4351 | (gnus-art-defun gnus-article-date-iso8601) |
| 4352 | article-date-local | 4352 | (gnus-art-defun gnus-article-date-original) |
| 4353 | article-date-english | 4353 | (gnus-art-defun gnus-article-treat-date) |
| 4354 | article-date-iso8601 | 4354 | (gnus-art-defun gnus-article-date-ut) |
| 4355 | article-date-original | 4355 | (gnus-art-defun gnus-article-decode-mime-words) |
| 4356 | article-treat-date | 4356 | (gnus-art-defun gnus-article-decode-charset) |
| 4357 | article-date-ut | 4357 | (gnus-art-defun gnus-article-decode-encoded-words) |
| 4358 | article-decode-mime-words | 4358 | (gnus-art-defun gnus-article-date-user) |
| 4359 | article-decode-charset | 4359 | (gnus-art-defun gnus-article-date-lapsed) |
| 4360 | article-decode-encoded-words | 4360 | (gnus-art-defun gnus-article-date-combined-lapsed) |
| 4361 | article-date-user | 4361 | (gnus-art-defun gnus-article-emphasize) |
| 4362 | article-date-lapsed | 4362 | (gnus-art-defun gnus-article-treat-dumbquotes) |
| 4363 | article-date-combined-lapsed | 4363 | (gnus-art-defun gnus-article-treat-non-ascii) |
| 4364 | article-emphasize | 4364 | (gnus-art-defun gnus-article-normalize-headers) |
| 4365 | article-treat-dumbquotes | 4365 | ;;(gnus-art-defun gnus-article-show-all-headers article-show-all) |
| 4366 | article-treat-non-ascii | ||
| 4367 | article-normalize-headers | ||
| 4368 | ;;(article-show-all . gnus-article-show-all-headers) | ||
| 4369 | ))) | ||
| 4370 | 4366 | ||
| 4371 | ;;; | 4367 | ;;; |
| 4372 | ;;; Gnus article mode | 4368 | ;;; Gnus article mode |
| @@ -4869,17 +4865,18 @@ General format specifiers can also be used. See Info node | |||
| 4869 | (defvar gnus-mime-button-map | 4865 | (defvar gnus-mime-button-map |
| 4870 | (let ((map (make-sparse-keymap))) | 4866 | (let ((map (make-sparse-keymap))) |
| 4871 | (define-key map [mouse-2] 'gnus-article-push-button) | 4867 | (define-key map [mouse-2] 'gnus-article-push-button) |
| 4872 | (define-key map [down-mouse-3] 'gnus-mime-button-menu) | ||
| 4873 | (dolist (c gnus-mime-button-commands) | 4868 | (dolist (c gnus-mime-button-commands) |
| 4874 | (define-key map (cadr c) (car c))) | 4869 | (define-key map (cadr c) (car c))) |
| 4875 | map)) | ||
| 4876 | 4870 | ||
| 4877 | (easy-menu-define | 4871 | (easy-menu-define gnus-mime-button-menu map "MIME button menu." |
| 4878 | gnus-mime-button-menu gnus-mime-button-map "MIME button menu." | 4872 | `("MIME Part" |
| 4879 | `("MIME Part" | 4873 | ,@(mapcar (lambda (c) |
| 4880 | ,@(mapcar (lambda (c) | 4874 | (vector (caddr c) (car c) :active t)) |
| 4881 | (vector (caddr c) (car c) :active t)) | 4875 | gnus-mime-button-commands))) |
| 4882 | gnus-mime-button-commands))) | 4876 | |
| 4877 | (define-key map [down-mouse-3] | ||
| 4878 | (easy-menu-binding gnus-mime-button-menu)) | ||
| 4879 | map)) | ||
| 4883 | 4880 | ||
| 4884 | (defvar gnus-url-button-commands | 4881 | (defvar gnus-url-button-commands |
| 4885 | '((gnus-article-copy-string "u" "Copy URL to kill ring"))) | 4882 | '((gnus-article-copy-string "u" "Copy URL to kill ring"))) |
| @@ -4923,16 +4920,6 @@ General format specifiers can also be used. See Info node | |||
| 4923 | (setq mm-w3m-safe-url-regexp nil))) | 4920 | (setq mm-w3m-safe-url-regexp nil))) |
| 4924 | ,@body)) | 4921 | ,@body)) |
| 4925 | 4922 | ||
| 4926 | (defun gnus-mime-button-menu (event prefix) | ||
| 4927 | "Construct a context-sensitive menu of MIME commands." | ||
| 4928 | (interactive "e\nP") | ||
| 4929 | (save-window-excursion | ||
| 4930 | (let ((pos (event-start event))) | ||
| 4931 | (select-window (posn-window pos)) | ||
| 4932 | (goto-char (posn-point pos)) | ||
| 4933 | (gnus-article-check-buffer) | ||
| 4934 | (popup-menu gnus-mime-button-menu nil prefix)))) | ||
| 4935 | |||
| 4936 | (defun gnus-mime-view-all-parts (&optional handles) | 4923 | (defun gnus-mime-view-all-parts (&optional handles) |
| 4937 | "View all the MIME parts." | 4924 | "View all the MIME parts." |
| 4938 | (interactive) | 4925 | (interactive) |
| @@ -5055,10 +5042,12 @@ and `gnus-mime-delete-part', and not provided at run-time normally." | |||
| 5055 | nil nil))) | 5042 | nil nil))) |
| 5056 | (gnus-mime-save-part-and-strip file)) | 5043 | (gnus-mime-save-part-and-strip file)) |
| 5057 | 5044 | ||
| 5058 | (defun gnus-mime-save-part-and-strip (&optional file) | 5045 | (defun gnus-mime-save-part-and-strip (&optional file event) |
| 5059 | "Save the MIME part under point then replace it with an external body. | 5046 | "Save the MIME part under point then replace it with an external body. |
| 5060 | If FILE is given, use it for the external part." | 5047 | If FILE is given, use it for the external part." |
| 5061 | (interactive) | 5048 | (interactive (list nil last-nonmenu-event)) |
| 5049 | (save-excursion | ||
| 5050 | (mouse-set-point event) | ||
| 5062 | (gnus-article-check-buffer) | 5051 | (gnus-article-check-buffer) |
| 5063 | (when (gnus-group-read-only-p) | 5052 | (when (gnus-group-read-only-p) |
| 5064 | (error "The current group does not support deleting of parts")) | 5053 | (error "The current group does not support deleting of parts")) |
| @@ -5090,15 +5079,16 @@ The current article has a complicated MIME structure, giving up...")) | |||
| 5090 | (access-type . "LOCAL-FILE") | 5079 | (access-type . "LOCAL-FILE") |
| 5091 | (name . ,file))))) | 5080 | (name . ,file))))) |
| 5092 | ;; (set-buffer gnus-summary-buffer) | 5081 | ;; (set-buffer gnus-summary-buffer) |
| 5093 | (gnus-article-edit-part handles id)))) | 5082 | (gnus-article-edit-part handles id))))) |
| 5094 | 5083 | ||
| 5095 | ;; A function like `gnus-summary-save-parts' (`X m', `<MIME> <Extract all | 5084 | ;; A function like `gnus-summary-save-parts' (`X m', `<MIME> <Extract all |
| 5096 | ;; parts...>') but with stripping would be nice. | 5085 | ;; parts...>') but with stripping would be nice. |
| 5097 | 5086 | ||
| 5098 | (defun gnus-mime-delete-part () | 5087 | (defun gnus-mime-delete-part (&optional event) |
| 5099 | "Delete the MIME part under point. | 5088 | "Delete the MIME part under point. |
| 5100 | Replace it with some information about the removed part." | 5089 | Replace it with some information about the removed part." |
| 5101 | (interactive) | 5090 | (interactive (list last-nonmenu-event)) |
| 5091 | (mouse-set-point event) | ||
| 5102 | (gnus-article-check-buffer) | 5092 | (gnus-article-check-buffer) |
| 5103 | (when (gnus-group-read-only-p) | 5093 | (when (gnus-group-read-only-p) |
| 5104 | (error "The current group does not support deleting of parts")) | 5094 | (error "The current group does not support deleting of parts")) |
| @@ -5144,33 +5134,36 @@ Deleting parts may malfunction or destroy the article; continue? ")) | |||
| 5144 | ;; (set-buffer gnus-summary-buffer) | 5134 | ;; (set-buffer gnus-summary-buffer) |
| 5145 | (gnus-article-edit-part handles id)))) | 5135 | (gnus-article-edit-part handles id)))) |
| 5146 | 5136 | ||
| 5147 | (defun gnus-mime-save-part () | 5137 | (defun gnus-mime-save-part (&optional event) |
| 5148 | "Save the MIME part under point." | 5138 | "Save the MIME part under point." |
| 5149 | (interactive) | 5139 | (interactive (list last-nonmenu-event)) |
| 5140 | (mouse-set-point event) | ||
| 5150 | (gnus-article-check-buffer) | 5141 | (gnus-article-check-buffer) |
| 5151 | (let ((data (get-text-property (point) 'gnus-data))) | 5142 | (let ((data (get-text-property (point) 'gnus-data))) |
| 5152 | (when data | 5143 | (when data |
| 5153 | (mm-save-part data)))) | 5144 | (mm-save-part data)))) |
| 5154 | 5145 | ||
| 5155 | (defun gnus-mime-pipe-part (&optional cmd) | 5146 | (defun gnus-mime-pipe-part (&optional cmd event) |
| 5156 | "Pipe the MIME part under point to a process. | 5147 | "Pipe the MIME part under point to a process." |
| 5157 | Use CMD as the process." | 5148 | (interactive (list nil last-nonmenu-event)) |
| 5158 | (interactive) | 5149 | (mouse-set-point event) |
| 5159 | (gnus-article-check-buffer) | 5150 | (gnus-article-check-buffer) |
| 5160 | (let ((data (get-text-property (point) 'gnus-data))) | 5151 | (let ((data (get-text-property (point) 'gnus-data))) |
| 5161 | (when data | 5152 | (when data |
| 5162 | (mm-pipe-part data cmd)))) | 5153 | (mm-pipe-part data cmd)))) |
| 5163 | 5154 | ||
| 5164 | (defun gnus-mime-view-part () | 5155 | (defun gnus-mime-view-part (&optional event) |
| 5165 | "Interactively choose a viewing method for the MIME part under point." | 5156 | "Interactively choose a viewing method for the MIME part under point." |
| 5166 | (interactive) | 5157 | (interactive (list last-nonmenu-event)) |
| 5167 | (gnus-article-check-buffer) | 5158 | (save-excursion |
| 5168 | (let ((data (get-text-property (point) 'gnus-data))) | 5159 | (mouse-set-point event) |
| 5169 | (when data | 5160 | (gnus-article-check-buffer) |
| 5170 | (setq gnus-article-mime-handles | 5161 | (let ((data (get-text-property (point) 'gnus-data))) |
| 5171 | (mm-merge-handles | 5162 | (when data |
| 5172 | gnus-article-mime-handles (setq data (copy-sequence data)))) | 5163 | (setq gnus-article-mime-handles |
| 5173 | (mm-interactively-view-part data)))) | 5164 | (mm-merge-handles |
| 5165 | gnus-article-mime-handles (setq data (copy-sequence data)))) | ||
| 5166 | (mm-interactively-view-part data))))) | ||
| 5174 | 5167 | ||
| 5175 | (defun gnus-mime-view-part-as-type-internal () | 5168 | (defun gnus-mime-view-part-as-type-internal () |
| 5176 | (gnus-article-check-buffer) | 5169 | (gnus-article-check-buffer) |
| @@ -5187,11 +5180,13 @@ Use CMD as the process." | |||
| 5187 | '("text/plain" . 0)) | 5180 | '("text/plain" . 0)) |
| 5188 | '("application/octet-stream" . 0)))) | 5181 | '("application/octet-stream" . 0)))) |
| 5189 | 5182 | ||
| 5190 | (defun gnus-mime-view-part-as-type (&optional mime-type pred) | 5183 | (defun gnus-mime-view-part-as-type (&optional mime-type pred event) |
| 5191 | "Choose a MIME media type, and view the part as such. | 5184 | "Choose a MIME media type, and view the part as such. |
| 5192 | If non-nil, PRED is a predicate to use during completion to limit the | 5185 | If non-nil, PRED is a predicate to use during completion to limit the |
| 5193 | available media-types." | 5186 | available media-types." |
| 5194 | (interactive) | 5187 | (interactive (list nil nil last-nonmenu-event)) |
| 5188 | (save-excursion | ||
| 5189 | (if event (mouse-set-point event)) | ||
| 5195 | (unless mime-type | 5190 | (unless mime-type |
| 5196 | (setq mime-type | 5191 | (setq mime-type |
| 5197 | (let ((default (gnus-mime-view-part-as-type-internal))) | 5192 | (let ((default (gnus-mime-view-part-as-type-internal))) |
| @@ -5222,13 +5217,14 @@ available media-types." | |||
| 5222 | (mm-merge-handles gnus-article-mime-handles handle)) | 5217 | (mm-merge-handles gnus-article-mime-handles handle)) |
| 5223 | (when (mm-handle-displayed-p handle) | 5218 | (when (mm-handle-displayed-p handle) |
| 5224 | (mm-remove-part handle)) | 5219 | (mm-remove-part handle)) |
| 5225 | (gnus-mm-display-part handle)))) | 5220 | (gnus-mm-display-part handle))))) |
| 5226 | 5221 | ||
| 5227 | (defun gnus-mime-copy-part (&optional handle arg) | 5222 | (defun gnus-mime-copy-part (&optional handle arg event) |
| 5228 | "Put the MIME part under point into a new buffer. | 5223 | "Put the MIME part under point into a new buffer. |
| 5229 | If `auto-compression-mode' is enabled, compressed files like .gz and .bz2 | 5224 | If `auto-compression-mode' is enabled, compressed files like .gz and .bz2 |
| 5230 | are decompressed." | 5225 | are decompressed." |
| 5231 | (interactive (list nil current-prefix-arg)) | 5226 | (interactive (list nil current-prefix-arg last-nonmenu-event)) |
| 5227 | (mouse-set-point event) | ||
| 5232 | (gnus-article-check-buffer) | 5228 | (gnus-article-check-buffer) |
| 5233 | (unless handle | 5229 | (unless handle |
| 5234 | (setq handle (get-text-property (point) 'gnus-data))) | 5230 | (setq handle (get-text-property (point) 'gnus-data))) |
| @@ -5280,9 +5276,12 @@ are decompressed." | |||
| 5280 | (setq buffer-file-name nil)) | 5276 | (setq buffer-file-name nil)) |
| 5281 | (goto-char (point-min))))) | 5277 | (goto-char (point-min))))) |
| 5282 | 5278 | ||
| 5283 | (defun gnus-mime-print-part (&optional handle filename) | 5279 | (defun gnus-mime-print-part (&optional handle filename event) |
| 5284 | "Print the MIME part under point." | 5280 | "Print the MIME part under point." |
| 5285 | (interactive (list nil (ps-print-preprint current-prefix-arg))) | 5281 | (interactive |
| 5282 | (list nil (ps-print-preprint current-prefix-arg) last-nonmenu-event)) | ||
| 5283 | (save-excursion | ||
| 5284 | (mouse-set-point event) | ||
| 5286 | (gnus-article-check-buffer) | 5285 | (gnus-article-check-buffer) |
| 5287 | (let* ((handle (or handle (get-text-property (point) 'gnus-data))) | 5286 | (let* ((handle (or handle (get-text-property (point) 'gnus-data))) |
| 5288 | (contents (and handle (mm-get-part handle))) | 5287 | (contents (and handle (mm-get-part handle))) |
| @@ -5303,12 +5302,13 @@ are decompressed." | |||
| 5303 | (with-temp-buffer | 5302 | (with-temp-buffer |
| 5304 | (insert contents) | 5303 | (insert contents) |
| 5305 | (gnus-print-buffer)) | 5304 | (gnus-print-buffer)) |
| 5306 | (ps-despool filename))))) | 5305 | (ps-despool filename)))))) |
| 5307 | 5306 | ||
| 5308 | (defun gnus-mime-inline-part (&optional handle arg) | 5307 | (defun gnus-mime-inline-part (&optional handle arg event) |
| 5309 | "Insert the MIME part under point into the current buffer. | 5308 | "Insert the MIME part under point into the current buffer. |
| 5310 | Compressed files like .gz and .bz2 are decompressed." | 5309 | Compressed files like .gz and .bz2 are decompressed." |
| 5311 | (interactive (list nil current-prefix-arg)) | 5310 | (interactive (list nil current-prefix-arg last-nonmenu-event)) |
| 5311 | (if event (mouse-set-point event)) | ||
| 5312 | (gnus-article-check-buffer) | 5312 | (gnus-article-check-buffer) |
| 5313 | (let* ((inhibit-read-only t) | 5313 | (let* ((inhibit-read-only t) |
| 5314 | (b (point)) | 5314 | (b (point)) |
| @@ -5402,10 +5402,12 @@ CHARSET may either be a string or a symbol." | |||
| 5402 | (setcdr param charset) | 5402 | (setcdr param charset) |
| 5403 | (setcdr type (cons (cons 'charset charset) (cdr type))))))) | 5403 | (setcdr type (cons (cons 'charset charset) (cdr type))))))) |
| 5404 | 5404 | ||
| 5405 | (defun gnus-mime-view-part-as-charset (&optional handle arg) | 5405 | (defun gnus-mime-view-part-as-charset (&optional handle arg event) |
| 5406 | "Insert the MIME part under point into the current buffer using the | 5406 | "Insert the MIME part under point into the current buffer using the |
| 5407 | specified charset." | 5407 | specified charset." |
| 5408 | (interactive (list nil current-prefix-arg)) | 5408 | (interactive (list nil current-prefix-arg last-nonmenu-event)) |
| 5409 | (save-excursion | ||
| 5410 | (mouse-set-point event) | ||
| 5409 | (gnus-article-check-buffer) | 5411 | (gnus-article-check-buffer) |
| 5410 | (let ((handle (or handle (get-text-property (point) 'gnus-data))) | 5412 | (let ((handle (or handle (get-text-property (point) 'gnus-data))) |
| 5411 | (fun (get-text-property (point) 'gnus-callback)) | 5413 | (fun (get-text-property (point) 'gnus-callback)) |
| @@ -5439,11 +5441,13 @@ specified charset." | |||
| 5439 | (setcar (cddr form) | 5441 | (setcar (cddr form) |
| 5440 | (list 'quote (or (cadr (member preferred parts)) | 5442 | (list 'quote (or (cadr (member preferred parts)) |
| 5441 | (car parts))))) | 5443 | (car parts))))) |
| 5442 | (funcall fun handle))))) | 5444 | (funcall fun handle)))))) |
| 5443 | 5445 | ||
| 5444 | (defun gnus-mime-view-part-externally (&optional handle) | 5446 | (defun gnus-mime-view-part-externally (&optional handle event) |
| 5445 | "View the MIME part under point with an external viewer." | 5447 | "View the MIME part under point with an external viewer." |
| 5446 | (interactive) | 5448 | (interactive (list nil last-nonmenu-event)) |
| 5449 | (save-excursion | ||
| 5450 | (mouse-set-point event) | ||
| 5447 | (gnus-article-check-buffer) | 5451 | (gnus-article-check-buffer) |
| 5448 | (let* ((handle (or handle (get-text-property (point) 'gnus-data))) | 5452 | (let* ((handle (or handle (get-text-property (point) 'gnus-data))) |
| 5449 | (mm-inlined-types nil) | 5453 | (mm-inlined-types nil) |
| @@ -5458,12 +5462,14 @@ specified charset." | |||
| 5458 | (gnus-mime-view-part-as-type | 5462 | (gnus-mime-view-part-as-type |
| 5459 | nil (lambda (type) (stringp (mailcap-mime-info type)))) | 5463 | nil (lambda (type) (stringp (mailcap-mime-info type)))) |
| 5460 | (when handle | 5464 | (when handle |
| 5461 | (mm-display-part handle nil t))))) | 5465 | (mm-display-part handle nil t)))))) |
| 5462 | 5466 | ||
| 5463 | (defun gnus-mime-view-part-internally (&optional handle) | 5467 | (defun gnus-mime-view-part-internally (&optional handle event) |
| 5464 | "View the MIME part under point with an internal viewer. | 5468 | "View the MIME part under point with an internal viewer. |
| 5465 | If no internal viewer is available, use an external viewer." | 5469 | If no internal viewer is available, use an external viewer." |
| 5466 | (interactive) | 5470 | (interactive (list nil last-nonmenu-event)) |
| 5471 | (save-excursion | ||
| 5472 | (mouse-set-point event) | ||
| 5467 | (gnus-article-check-buffer) | 5473 | (gnus-article-check-buffer) |
| 5468 | (let* ((handle (or handle (get-text-property (point) 'gnus-data))) | 5474 | (let* ((handle (or handle (get-text-property (point) 'gnus-data))) |
| 5469 | (mm-inlined-types '(".*")) | 5475 | (mm-inlined-types '(".*")) |
| @@ -5477,7 +5483,7 @@ If no internal viewer is available, use an external viewer." | |||
| 5477 | (gnus-mime-view-part-as-type | 5483 | (gnus-mime-view-part-as-type |
| 5478 | nil (lambda (type) (mm-inlinable-p handle type))) | 5484 | nil (lambda (type) (mm-inlinable-p handle type))) |
| 5479 | (when handle | 5485 | (when handle |
| 5480 | (gnus-bind-mm-vars (mm-display-part handle nil t)))))) | 5486 | (gnus-bind-mm-vars (mm-display-part handle nil t))))))) |
| 5481 | 5487 | ||
| 5482 | (defun gnus-mime-action-on-part (&optional action) | 5488 | (defun gnus-mime-action-on-part (&optional action) |
| 5483 | "Do something with the MIME attachment at (point)." | 5489 | "Do something with the MIME attachment at (point)." |
| @@ -5849,7 +5855,7 @@ all parts." | |||
| 5849 | (widget-convert-button | 5855 | (widget-convert-button |
| 5850 | 'link b e | 5856 | 'link b e |
| 5851 | :mime-handle handle | 5857 | :mime-handle handle |
| 5852 | :action 'gnus-widget-press-button | 5858 | :action #'gnus-widget-press-button |
| 5853 | :button-keymap gnus-mime-button-map | 5859 | :button-keymap gnus-mime-button-map |
| 5854 | :help-echo | 5860 | :help-echo |
| 5855 | (lambda (widget) | 5861 | (lambda (widget) |
| @@ -6148,7 +6154,7 @@ If nil, don't show those extra buttons." | |||
| 6148 | article-type multipart | 6154 | article-type multipart |
| 6149 | rear-nonsticky t)) | 6155 | rear-nonsticky t)) |
| 6150 | (widget-convert-button 'link from (point) | 6156 | (widget-convert-button 'link from (point) |
| 6151 | :action 'gnus-widget-press-button) | 6157 | :action #'gnus-widget-press-button) |
| 6152 | ;; Do the handles | 6158 | ;; Do the handles |
| 6153 | (while (setq handle (pop handles)) | 6159 | (while (setq handle (pop handles)) |
| 6154 | (add-text-properties | 6160 | (add-text-properties |
| @@ -6172,7 +6178,7 @@ If nil, don't show those extra buttons." | |||
| 6172 | gnus-data ,handle | 6178 | gnus-data ,handle |
| 6173 | rear-nonsticky t)) | 6179 | rear-nonsticky t)) |
| 6174 | (widget-convert-button 'link from (point) | 6180 | (widget-convert-button 'link from (point) |
| 6175 | :action 'gnus-widget-press-button) | 6181 | :action #'gnus-widget-press-button) |
| 6176 | (insert " ")) | 6182 | (insert " ")) |
| 6177 | (insert "\n\n")) | 6183 | (insert "\n\n")) |
| 6178 | (when preferred | 6184 | (when preferred |
| @@ -7115,13 +7121,11 @@ If given a prefix, show the hidden text instead." | |||
| 7115 | (when (and do-update-line | 7121 | (when (and do-update-line |
| 7116 | (or (numberp article) | 7122 | (or (numberp article) |
| 7117 | (stringp article))) | 7123 | (stringp article))) |
| 7118 | (let ((buf (current-buffer))) | 7124 | (with-current-buffer gnus-summary-buffer |
| 7119 | (set-buffer gnus-summary-buffer) | ||
| 7120 | (gnus-summary-update-article do-update-line sparse-header) | 7125 | (gnus-summary-update-article do-update-line sparse-header) |
| 7121 | (gnus-summary-goto-subject do-update-line nil t) | 7126 | (gnus-summary-goto-subject do-update-line nil t) |
| 7122 | (set-window-point (gnus-get-buffer-window (current-buffer) t) | 7127 | (set-window-point (gnus-get-buffer-window (current-buffer) t) |
| 7123 | (point)) | 7128 | (point))))))) |
| 7124 | (set-buffer buf)))))) | ||
| 7125 | 7129 | ||
| 7126 | (defun gnus-block-private-groups (group) | 7130 | (defun gnus-block-private-groups (group) |
| 7127 | "Allows images in newsgroups to be shown, blocks images in all | 7131 | "Allows images in newsgroups to be shown, blocks images in all |
| @@ -7316,8 +7320,7 @@ groups." | |||
| 7316 | (gnus-article-mode) | 7320 | (gnus-article-mode) |
| 7317 | (set-window-configuration winconf) | 7321 | (set-window-configuration winconf) |
| 7318 | ;; Tippy-toe some to make sure that point remains where it was. | 7322 | ;; Tippy-toe some to make sure that point remains where it was. |
| 7319 | (save-current-buffer | 7323 | (with-current-buffer curbuf |
| 7320 | (set-buffer curbuf) | ||
| 7321 | (set-window-start (get-buffer-window (current-buffer)) window-start) | 7324 | (set-window-start (get-buffer-window (current-buffer)) window-start) |
| 7322 | (goto-char p)))) | 7325 | (goto-char p)))) |
| 7323 | (gnus-summary-show-article))) | 7326 | (gnus-summary-show-article))) |
| @@ -7869,15 +7872,16 @@ call it with the value of the `gnus-data' text property." | |||
| 7869 | (when fun | 7872 | (when fun |
| 7870 | (funcall fun data)))) | 7873 | (funcall fun data)))) |
| 7871 | 7874 | ||
| 7872 | (defun gnus-article-press-button () | 7875 | (defun gnus-article-press-button (&optional event) |
| 7873 | "Check text at point for a callback function. | 7876 | "Check text at point for a callback function. |
| 7874 | If the text at point has a `gnus-callback' property, | 7877 | If the text at point has a `gnus-callback' property, |
| 7875 | call it with the value of the `gnus-data' text property." | 7878 | call it with the value of the `gnus-data' text property." |
| 7876 | (interactive) | 7879 | (interactive (list last-nonmenu-event)) |
| 7877 | (let ((data (get-text-property (point) 'gnus-data)) | 7880 | (save-excursion |
| 7878 | (fun (get-text-property (point) 'gnus-callback))) | 7881 | (mouse-set-point event) |
| 7879 | (when fun | 7882 | (let ((fun (get-text-property (point) 'gnus-callback))) |
| 7880 | (funcall fun data)))) | 7883 | (when fun |
| 7884 | (funcall fun (get-text-property (point) 'gnus-data)))))) | ||
| 7881 | 7885 | ||
| 7882 | (defun gnus-article-highlight (&optional force) | 7886 | (defun gnus-article-highlight (&optional force) |
| 7883 | "Highlight current article. | 7887 | "Highlight current article. |
| @@ -8095,7 +8099,7 @@ url is put as the `gnus-button-url' overlay property on the button." | |||
| 8095 | (list 'mouse-face gnus-article-mouse-face)) | 8099 | (list 'mouse-face gnus-article-mouse-face)) |
| 8096 | (list 'gnus-callback fun) | 8100 | (list 'gnus-callback fun) |
| 8097 | (and data (list 'gnus-data data)))) | 8101 | (and data (list 'gnus-data data)))) |
| 8098 | (widget-convert-button 'link from to :action 'gnus-widget-press-button | 8102 | (widget-convert-button 'link from to :action #'gnus-widget-press-button |
| 8099 | :help-echo (or text "Follow the link") | 8103 | :help-echo (or text "Follow the link") |
| 8100 | :keymap gnus-url-button-map)) | 8104 | :keymap gnus-url-button-map)) |
| 8101 | 8105 | ||
diff --git a/lisp/gnus/gnus-cloud.el b/lisp/gnus/gnus-cloud.el index 485f815d9b9..9ae28b1290e 100644 --- a/lisp/gnus/gnus-cloud.el +++ b/lisp/gnus/gnus-cloud.el | |||
| @@ -1,4 +1,4 @@ | |||
| 1 | ;;; gnus-cloud.el --- storing and retrieving data via IMAP | 1 | ;;; gnus-cloud.el --- storing and retrieving data via IMAP -*- lexical-binding:t -*- |
| 2 | 2 | ||
| 3 | ;; Copyright (C) 2014-2019 Free Software Foundation, Inc. | 3 | ;; Copyright (C) 2014-2019 Free Software Foundation, Inc. |
| 4 | 4 | ||
| @@ -52,14 +52,12 @@ Each element may be either a string or a property list. | |||
| 52 | The latter should have a :directory element whose value is a string, | 52 | The latter should have a :directory element whose value is a string, |
| 53 | and a :match element whose value is a regular expression to match | 53 | and a :match element whose value is a regular expression to match |
| 54 | against the basename of files in said directory." | 54 | against the basename of files in said directory." |
| 55 | :group 'gnus-cloud | ||
| 56 | :type '(repeat (choice (string :tag "File") | 55 | :type '(repeat (choice (string :tag "File") |
| 57 | (plist :tag "Property list")))) | 56 | (plist :tag "Property list")))) |
| 58 | 57 | ||
| 59 | (defcustom gnus-cloud-storage-method (if (featurep 'epg) 'epg 'base64-gzip) | 58 | (defcustom gnus-cloud-storage-method (if (featurep 'epg) 'epg 'base64-gzip) |
| 60 | "Storage method for cloud data, defaults to EPG if that's available." | 59 | "Storage method for cloud data, defaults to EPG if that's available." |
| 61 | :version "26.1" | 60 | :version "26.1" |
| 62 | :group 'gnus-cloud | ||
| 63 | :type '(radio (const :tag "No encoding" nil) | 61 | :type '(radio (const :tag "No encoding" nil) |
| 64 | (const :tag "Base64" base64) | 62 | (const :tag "Base64" base64) |
| 65 | (const :tag "Base64+gzip" base64-gzip) | 63 | (const :tag "Base64+gzip" base64-gzip) |
| @@ -68,7 +66,6 @@ against the basename of files in said directory." | |||
| 68 | (defcustom gnus-cloud-interactive t | 66 | (defcustom gnus-cloud-interactive t |
| 69 | "Whether Gnus Cloud changes should be confirmed." | 67 | "Whether Gnus Cloud changes should be confirmed." |
| 70 | :version "26.1" | 68 | :version "26.1" |
| 71 | :group 'gnus-cloud | ||
| 72 | :type 'boolean) | 69 | :type 'boolean) |
| 73 | 70 | ||
| 74 | (defvar gnus-cloud-group-name "Emacs-Cloud") | 71 | (defvar gnus-cloud-group-name "Emacs-Cloud") |
| @@ -81,7 +78,6 @@ against the basename of files in said directory." | |||
| 81 | "The IMAP select method used to store the cloud data. | 78 | "The IMAP select method used to store the cloud data. |
| 82 | See also `gnus-server-set-cloud-method-server' for an | 79 | See also `gnus-server-set-cloud-method-server' for an |
| 83 | easy interactive way to set this from the Server buffer." | 80 | easy interactive way to set this from the Server buffer." |
| 84 | :group 'gnus-cloud | ||
| 85 | :type '(radio (const :tag "Not set" nil) | 81 | :type '(radio (const :tag "Not set" nil) |
| 86 | (string :tag "A Gnus server name as a string"))) | 82 | (string :tag "A Gnus server name as a string"))) |
| 87 | 83 | ||
| @@ -131,8 +127,7 @@ easy interactive way to set this from the Server buffer." | |||
| 131 | (base64-encode-region (point-min) (point-max))) | 127 | (base64-encode-region (point-min) (point-max))) |
| 132 | 128 | ||
| 133 | ((eq gnus-cloud-storage-method 'epg) | 129 | ((eq gnus-cloud-storage-method 'epg) |
| 134 | (let ((context (epg-make-context 'OpenPGP)) | 130 | (let ((context (epg-make-context 'OpenPGP))) |
| 135 | cipher) | ||
| 136 | (setf (epg-context-armor context) t) | 131 | (setf (epg-context-armor context) t) |
| 137 | (setf (epg-context-textmode context) t) | 132 | (setf (epg-context-textmode context) t) |
| 138 | (let ((data (epg-encrypt-string context | 133 | (let ((data (epg-encrypt-string context |
| @@ -353,6 +348,7 @@ Use old data if FORCE-OLDER is not nil." | |||
| 353 | (group &optional previous method)) | 348 | (group &optional previous method)) |
| 354 | 349 | ||
| 355 | (defun gnus-cloud-ensure-cloud-group () | 350 | (defun gnus-cloud-ensure-cloud-group () |
| 351 | ;; FIXME: `method' is not used!? | ||
| 356 | (let ((method (if (stringp gnus-cloud-method) | 352 | (let ((method (if (stringp gnus-cloud-method) |
| 357 | (gnus-server-to-method gnus-cloud-method) | 353 | (gnus-server-to-method gnus-cloud-method) |
| 358 | gnus-cloud-method))) | 354 | gnus-cloud-method))) |
diff --git a/lisp/gnus/gnus-topic.el b/lisp/gnus/gnus-topic.el index e2c728df8f4..4d10e1170da 100644 --- a/lisp/gnus/gnus-topic.el +++ b/lisp/gnus/gnus-topic.el | |||
| @@ -644,7 +644,14 @@ articles in the topic and its subtopics." | |||
| 644 | (add-text-properties | 644 | (add-text-properties |
| 645 | (point) | 645 | (point) |
| 646 | (prog1 (1+ (point)) | 646 | (prog1 (1+ (point)) |
| 647 | (eval gnus-topic-line-format-spec)) | 647 | (eval gnus-topic-line-format-spec |
| 648 | `((indentation . ,indentation) | ||
| 649 | (visible . ,visible) | ||
| 650 | (name . ,name) | ||
| 651 | (level . ,level) | ||
| 652 | (number-of-groups . ,number-of-groups) | ||
| 653 | (total-number-of-articles . ,total-number-of-articles) | ||
| 654 | (entries . ,entries)))) | ||
| 648 | (list 'gnus-topic name | 655 | (list 'gnus-topic name |
| 649 | 'gnus-topic-level level | 656 | 'gnus-topic-level level |
| 650 | 'gnus-topic-unread unread | 657 | 'gnus-topic-unread unread |
diff --git a/lisp/gnus/gnus-util.el b/lisp/gnus/gnus-util.el index 31421cc7555..fcd5ec621cc 100644 --- a/lisp/gnus/gnus-util.el +++ b/lisp/gnus/gnus-util.el | |||
| @@ -38,7 +38,7 @@ | |||
| 38 | (require 'time-date) | 38 | (require 'time-date) |
| 39 | (require 'text-property-search) | 39 | (require 'text-property-search) |
| 40 | 40 | ||
| 41 | (defcustom gnus-completing-read-function 'gnus-emacs-completing-read | 41 | (defcustom gnus-completing-read-function #'gnus-emacs-completing-read |
| 42 | "Function use to do completing read." | 42 | "Function use to do completing read." |
| 43 | :version "24.1" | 43 | :version "24.1" |
| 44 | :group 'gnus-meta | 44 | :group 'gnus-meta |
| @@ -87,6 +87,7 @@ This is a compatibility function for different Emacsen." | |||
| 87 | 87 | ||
| 88 | (defmacro gnus-eval-in-buffer-window (buffer &rest forms) | 88 | (defmacro gnus-eval-in-buffer-window (buffer &rest forms) |
| 89 | "Pop to BUFFER, evaluate FORMS, and then return to the original window." | 89 | "Pop to BUFFER, evaluate FORMS, and then return to the original window." |
| 90 | (declare (indent 1) (debug (form body))) | ||
| 90 | (let ((tempvar (make-symbol "GnusStartBufferWindow")) | 91 | (let ((tempvar (make-symbol "GnusStartBufferWindow")) |
| 91 | (w (make-symbol "w")) | 92 | (w (make-symbol "w")) |
| 92 | (buf (make-symbol "buf"))) | 93 | (buf (make-symbol "buf"))) |
| @@ -103,9 +104,6 @@ This is a compatibility function for different Emacsen." | |||
| 103 | ,@forms) | 104 | ,@forms) |
| 104 | (select-window ,tempvar))))) | 105 | (select-window ,tempvar))))) |
| 105 | 106 | ||
| 106 | (put 'gnus-eval-in-buffer-window 'lisp-indent-function 1) | ||
| 107 | (put 'gnus-eval-in-buffer-window 'edebug-form-spec '(form body)) | ||
| 108 | |||
| 109 | (defsubst gnus-goto-char (point) | 107 | (defsubst gnus-goto-char (point) |
| 110 | (and point (goto-char point))) | 108 | (and point (goto-char point))) |
| 111 | 109 | ||
| @@ -302,26 +300,24 @@ Symbols are also allowed; their print names are used instead." | |||
| 302 | 300 | ||
| 303 | (defmacro gnus-local-set-keys (&rest plist) | 301 | (defmacro gnus-local-set-keys (&rest plist) |
| 304 | "Set the keys in PLIST in the current keymap." | 302 | "Set the keys in PLIST in the current keymap." |
| 303 | (declare (indent 1)) | ||
| 305 | `(gnus-define-keys-1 (current-local-map) ',plist)) | 304 | `(gnus-define-keys-1 (current-local-map) ',plist)) |
| 306 | 305 | ||
| 307 | (defmacro gnus-define-keys (keymap &rest plist) | 306 | (defmacro gnus-define-keys (keymap &rest plist) |
| 308 | "Define all keys in PLIST in KEYMAP." | 307 | "Define all keys in PLIST in KEYMAP." |
| 308 | (declare (indent 1)) | ||
| 309 | `(gnus-define-keys-1 (quote ,keymap) (quote ,plist))) | 309 | `(gnus-define-keys-1 (quote ,keymap) (quote ,plist))) |
| 310 | 310 | ||
| 311 | (defmacro gnus-define-keys-safe (keymap &rest plist) | 311 | (defmacro gnus-define-keys-safe (keymap &rest plist) |
| 312 | "Define all keys in PLIST in KEYMAP without overwriting previous definitions." | 312 | "Define all keys in PLIST in KEYMAP without overwriting previous definitions." |
| 313 | (declare (indent 1)) | ||
| 313 | `(gnus-define-keys-1 (quote ,keymap) (quote ,plist) t)) | 314 | `(gnus-define-keys-1 (quote ,keymap) (quote ,plist) t)) |
| 314 | 315 | ||
| 315 | (put 'gnus-define-keys 'lisp-indent-function 1) | ||
| 316 | (put 'gnus-define-keys-safe 'lisp-indent-function 1) | ||
| 317 | (put 'gnus-local-set-keys 'lisp-indent-function 1) | ||
| 318 | |||
| 319 | (defmacro gnus-define-keymap (keymap &rest plist) | 316 | (defmacro gnus-define-keymap (keymap &rest plist) |
| 320 | "Define all keys in PLIST in KEYMAP." | 317 | "Define all keys in PLIST in KEYMAP." |
| 318 | (declare (indent 1)) | ||
| 321 | `(gnus-define-keys-1 ,keymap (quote ,plist))) | 319 | `(gnus-define-keys-1 ,keymap (quote ,plist))) |
| 322 | 320 | ||
| 323 | (put 'gnus-define-keymap 'lisp-indent-function 1) | ||
| 324 | |||
| 325 | (defun gnus-define-keys-1 (keymap plist &optional safe) | 321 | (defun gnus-define-keys-1 (keymap plist &optional safe) |
| 326 | (when (null keymap) | 322 | (when (null keymap) |
| 327 | (error "Can't set keys in a null keymap")) | 323 | (error "Can't set keys in a null keymap")) |
| @@ -444,7 +440,7 @@ displayed in the echo area." | |||
| 444 | `(let (str time) | 440 | `(let (str time) |
| 445 | (cond ((eq gnus-add-timestamp-to-message 'log) | 441 | (cond ((eq gnus-add-timestamp-to-message 'log) |
| 446 | (setq str (let (message-log-max) | 442 | (setq str (let (message-log-max) |
| 447 | (apply 'message ,format-string ,args))) | 443 | (apply #'message ,format-string ,args))) |
| 448 | (when (and message-log-max | 444 | (when (and message-log-max |
| 449 | (> message-log-max 0) | 445 | (> message-log-max 0) |
| 450 | (/= (length str) 0)) | 446 | (/= (length str) 0)) |
| @@ -462,7 +458,7 @@ displayed in the echo area." | |||
| 462 | (gnus-add-timestamp-to-message | 458 | (gnus-add-timestamp-to-message |
| 463 | (if (or (and (null ,format-string) (null ,args)) | 459 | (if (or (and (null ,format-string) (null ,args)) |
| 464 | (progn | 460 | (progn |
| 465 | (setq str (apply 'format ,format-string ,args)) | 461 | (setq str (apply #'format ,format-string ,args)) |
| 466 | (zerop (length str)))) | 462 | (zerop (length str)))) |
| 467 | (prog1 | 463 | (prog1 |
| 468 | (and ,format-string str) | 464 | (and ,format-string str) |
| @@ -471,7 +467,7 @@ displayed in the echo area." | |||
| 471 | (message "%s" (concat ,timestamp str)) | 467 | (message "%s" (concat ,timestamp str)) |
| 472 | str)) | 468 | str)) |
| 473 | (t | 469 | (t |
| 474 | (apply 'message ,format-string ,args))))))) | 470 | (apply #'message ,format-string ,args))))))) |
| 475 | 471 | ||
| 476 | (defvar gnus-action-message-log nil) | 472 | (defvar gnus-action-message-log nil) |
| 477 | 473 | ||
| @@ -490,9 +486,10 @@ that take a long time, 7 - not very important messages on stuff, 9 - messages | |||
| 490 | inside loops." | 486 | inside loops." |
| 491 | (if (<= level gnus-verbose) | 487 | (if (<= level gnus-verbose) |
| 492 | (let ((message | 488 | (let ((message |
| 493 | (if gnus-add-timestamp-to-message | 489 | (apply (if gnus-add-timestamp-to-message |
| 494 | (apply 'gnus-message-with-timestamp args) | 490 | #'gnus-message-with-timestamp |
| 495 | (apply 'message args)))) | 491 | #'message) |
| 492 | args))) | ||
| 496 | (when (and (consp gnus-action-message-log) | 493 | (when (and (consp gnus-action-message-log) |
| 497 | (<= level 3)) | 494 | (<= level 3)) |
| 498 | (push message gnus-action-message-log)) | 495 | (push message gnus-action-message-log)) |
| @@ -500,7 +497,7 @@ inside loops." | |||
| 500 | ;; We have to do this format thingy here even if the result isn't | 497 | ;; We have to do this format thingy here even if the result isn't |
| 501 | ;; shown - the return value has to be the same as the return value | 498 | ;; shown - the return value has to be the same as the return value |
| 502 | ;; from `message'. | 499 | ;; from `message'. |
| 503 | (apply 'format args))) | 500 | (apply #'format args))) |
| 504 | 501 | ||
| 505 | (defun gnus-final-warning () | 502 | (defun gnus-final-warning () |
| 506 | (when (and (consp gnus-action-message-log) | 503 | (when (and (consp gnus-action-message-log) |
| @@ -513,7 +510,7 @@ inside loops." | |||
| 513 | "Beep an error if LEVEL is equal to or less than `gnus-verbose'. | 510 | "Beep an error if LEVEL is equal to or less than `gnus-verbose'. |
| 514 | ARGS are passed to `message'." | 511 | ARGS are passed to `message'." |
| 515 | (when (<= (floor level) gnus-verbose) | 512 | (when (<= (floor level) gnus-verbose) |
| 516 | (apply 'message args) | 513 | (apply #'message args) |
| 517 | (ding) | 514 | (ding) |
| 518 | (let (duration) | 515 | (let (duration) |
| 519 | (when (and (floatp level) | 516 | (when (and (floatp level) |
| @@ -688,18 +685,20 @@ Lisp objects are loadable. Bind `print-quoted' and `print-readably' | |||
| 688 | to t, and `print-escape-multibyte', `print-escape-newlines', | 685 | to t, and `print-escape-multibyte', `print-escape-newlines', |
| 689 | `print-escape-nonascii', `print-length', `print-level' and | 686 | `print-escape-nonascii', `print-length', `print-level' and |
| 690 | `print-string-length' to nil." | 687 | `print-string-length' to nil." |
| 691 | `(let ((print-quoted t) | 688 | `(progn |
| 692 | (print-readably t) | 689 | (defvar print-string-length) (defvar print-readably) |
| 693 | ;;print-circle | 690 | (let ((print-quoted t) |
| 694 | ;;print-continuous-numbering | 691 | (print-readably t) |
| 695 | print-escape-multibyte | 692 | ;;print-circle |
| 696 | print-escape-newlines | 693 | ;;print-continuous-numbering |
| 697 | print-escape-nonascii | 694 | print-escape-multibyte |
| 698 | ;;print-gensym | 695 | print-escape-newlines |
| 699 | print-length | 696 | print-escape-nonascii |
| 700 | print-level | 697 | ;;print-gensym |
| 701 | print-string-length) | 698 | print-length |
| 702 | ,@forms)) | 699 | print-level |
| 700 | print-string-length) | ||
| 701 | ,@forms))) | ||
| 703 | 702 | ||
| 704 | (defun gnus-prin1 (form) | 703 | (defun gnus-prin1 (form) |
| 705 | "Use `prin1' on FORM in the current buffer. | 704 | "Use `prin1' on FORM in the current buffer. |
| @@ -852,11 +851,10 @@ the user are disabled, it is recommended that only the most minimal | |||
| 852 | operations are performed by FORMS. If you wish to assign many | 851 | operations are performed by FORMS. If you wish to assign many |
| 853 | complicated values atomically, compute the results into temporary | 852 | complicated values atomically, compute the results into temporary |
| 854 | variables and then do only the assignment atomically." | 853 | variables and then do only the assignment atomically." |
| 854 | (declare (indent 0)) | ||
| 855 | `(let ((inhibit-quit gnus-atomic-be-safe)) | 855 | `(let ((inhibit-quit gnus-atomic-be-safe)) |
| 856 | ,@forms)) | 856 | ,@forms)) |
| 857 | 857 | ||
| 858 | (put 'gnus-atomic-progn 'lisp-indent-function 0) | ||
| 859 | |||
| 860 | (defmacro gnus-atomic-progn-assign (protect &rest forms) | 858 | (defmacro gnus-atomic-progn-assign (protect &rest forms) |
| 861 | "Evaluate FORMS, but ensure that the variables listed in PROTECT | 859 | "Evaluate FORMS, but ensure that the variables listed in PROTECT |
| 862 | are not changed if anything in FORMS signals an error or otherwise | 860 | are not changed if anything in FORMS signals an error or otherwise |
| @@ -866,6 +864,7 @@ It is safe to use gnus-atomic-progn-assign with long computations. | |||
| 866 | Note that if any of the symbols in PROTECT were unbound, they will be | 864 | Note that if any of the symbols in PROTECT were unbound, they will be |
| 867 | set to nil on a successful assignment. In case of an error or other | 865 | set to nil on a successful assignment. In case of an error or other |
| 868 | non-local exit, it will still be unbound." | 866 | non-local exit, it will still be unbound." |
| 867 | (declare (indent 1)) ;;(debug (sexp body)) | ||
| 869 | (let* ((temp-sym-map (mapcar (lambda (x) (list (make-symbol | 868 | (let* ((temp-sym-map (mapcar (lambda (x) (list (make-symbol |
| 870 | (concat (symbol-name x) | 869 | (concat (symbol-name x) |
| 871 | "-tmp")) | 870 | "-tmp")) |
| @@ -878,8 +877,8 @@ non-local exit, it will still be unbound." | |||
| 878 | ,(cadr x)))) | 877 | ,(cadr x)))) |
| 879 | temp-sym-map)) | 878 | temp-sym-map)) |
| 880 | (sym-temp-let sym-temp-map) | 879 | (sym-temp-let sym-temp-map) |
| 881 | (temp-sym-assign (apply 'append temp-sym-map)) | 880 | (temp-sym-assign (apply #'append temp-sym-map)) |
| 882 | (sym-temp-assign (apply 'append sym-temp-map)) | 881 | (sym-temp-assign (apply #'append sym-temp-map)) |
| 883 | (result (make-symbol "result-tmp"))) | 882 | (result (make-symbol "result-tmp"))) |
| 884 | `(let (,@temp-sym-let | 883 | `(let (,@temp-sym-let |
| 885 | ,result) | 884 | ,result) |
| @@ -890,9 +889,6 @@ non-local exit, it will still be unbound." | |||
| 890 | (setq ,@sym-temp-assign)) | 889 | (setq ,@sym-temp-assign)) |
| 891 | ,result))) | 890 | ,result))) |
| 892 | 891 | ||
| 893 | (put 'gnus-atomic-progn-assign 'lisp-indent-function 1) | ||
| 894 | ;(put 'gnus-atomic-progn-assign 'edebug-form-spec '(sexp body)) | ||
| 895 | |||
| 896 | (defmacro gnus-atomic-setq (&rest pairs) | 892 | (defmacro gnus-atomic-setq (&rest pairs) |
| 897 | "Similar to setq, except that the real symbols are only assigned when | 893 | "Similar to setq, except that the real symbols are only assigned when |
| 898 | there are no errors. And when the real symbols are assigned, they are | 894 | there are no errors. And when the real symbols are assigned, they are |
| @@ -1102,16 +1098,16 @@ ARG is passed to the first function." | |||
| 1102 | (defun gnus-run-hooks (&rest funcs) | 1098 | (defun gnus-run-hooks (&rest funcs) |
| 1103 | "Does the same as `run-hooks', but saves the current buffer." | 1099 | "Does the same as `run-hooks', but saves the current buffer." |
| 1104 | (save-current-buffer | 1100 | (save-current-buffer |
| 1105 | (apply 'run-hooks funcs))) | 1101 | (apply #'run-hooks funcs))) |
| 1106 | 1102 | ||
| 1107 | (defun gnus-run-hook-with-args (hook &rest args) | 1103 | (defun gnus-run-hook-with-args (hook &rest args) |
| 1108 | "Does the same as `run-hook-with-args', but saves the current buffer." | 1104 | "Does the same as `run-hook-with-args', but saves the current buffer." |
| 1109 | (save-current-buffer | 1105 | (save-current-buffer |
| 1110 | (apply 'run-hook-with-args hook args))) | 1106 | (apply #'run-hook-with-args hook args))) |
| 1111 | 1107 | ||
| 1112 | (defun gnus-run-mode-hooks (&rest funcs) | 1108 | (defun gnus-run-mode-hooks (&rest funcs) |
| 1113 | "Run `run-mode-hooks', saving the current buffer." | 1109 | "Run `run-mode-hooks', saving the current buffer." |
| 1114 | (save-current-buffer (apply 'run-mode-hooks funcs))) | 1110 | (save-current-buffer (apply #'run-mode-hooks funcs))) |
| 1115 | 1111 | ||
| 1116 | ;;; Various | 1112 | ;;; Various |
| 1117 | 1113 | ||
| @@ -1194,6 +1190,7 @@ ARG is passed to the first function." | |||
| 1194 | 1190 | ||
| 1195 | ;; Fixme: Why not use `with-output-to-temp-buffer'? | 1191 | ;; Fixme: Why not use `with-output-to-temp-buffer'? |
| 1196 | (defmacro gnus-with-output-to-file (file &rest body) | 1192 | (defmacro gnus-with-output-to-file (file &rest body) |
| 1193 | (declare (indent 1) (debug (form body))) | ||
| 1197 | (let ((buffer (make-symbol "output-buffer")) | 1194 | (let ((buffer (make-symbol "output-buffer")) |
| 1198 | (size (make-symbol "output-buffer-size")) | 1195 | (size (make-symbol "output-buffer-size")) |
| 1199 | (leng (make-symbol "output-buffer-length")) | 1196 | (leng (make-symbol "output-buffer-length")) |
| @@ -1216,9 +1213,6 @@ ARG is passed to the first function." | |||
| 1216 | (write-region (substring ,buffer 0 ,leng) nil ,file | 1213 | (write-region (substring ,buffer 0 ,leng) nil ,file |
| 1217 | ,append 'no-msg)))))) | 1214 | ,append 'no-msg)))))) |
| 1218 | 1215 | ||
| 1219 | (put 'gnus-with-output-to-file 'lisp-indent-function 1) | ||
| 1220 | (put 'gnus-with-output-to-file 'edebug-form-spec '(form body)) | ||
| 1221 | |||
| 1222 | (defun gnus-add-text-properties-when | 1216 | (defun gnus-add-text-properties-when |
| 1223 | (property value start end properties &optional object) | 1217 | (property value start end properties &optional object) |
| 1224 | "Like `add-text-properties', only applied on where PROPERTY is VALUE." | 1218 | "Like `add-text-properties', only applied on where PROPERTY is VALUE." |
| @@ -1306,7 +1300,7 @@ sure of changing the value of `foo'." | |||
| 1306 | (setq gnus-info-buffer (current-buffer)) | 1300 | (setq gnus-info-buffer (current-buffer)) |
| 1307 | (gnus-configure-windows 'info))) | 1301 | (gnus-configure-windows 'info))) |
| 1308 | 1302 | ||
| 1309 | (defun gnus-not-ignore (&rest args) | 1303 | (defun gnus-not-ignore (&rest _) |
| 1310 | t) | 1304 | t) |
| 1311 | 1305 | ||
| 1312 | (defvar gnus-directory-sep-char-regexp "/" | 1306 | (defvar gnus-directory-sep-char-regexp "/" |
| @@ -1358,7 +1352,7 @@ SPEC is a predicate specifier that contains stuff like `or', `and', | |||
| 1358 | `(,spec elem)) | 1352 | `(,spec elem)) |
| 1359 | ((listp spec) | 1353 | ((listp spec) |
| 1360 | (if (memq (car spec) '(or and not)) | 1354 | (if (memq (car spec) '(or and not)) |
| 1361 | `(,(car spec) ,@(mapcar 'gnus-make-predicate-1 (cdr spec))) | 1355 | `(,(car spec) ,@(mapcar #'gnus-make-predicate-1 (cdr spec))) |
| 1362 | (error "Invalid predicate specifier: %s" spec))))) | 1356 | (error "Invalid predicate specifier: %s" spec))))) |
| 1363 | 1357 | ||
| 1364 | (defun gnus-completing-read (prompt collection &optional require-match | 1358 | (defun gnus-completing-read (prompt collection &optional require-match |
| @@ -1397,6 +1391,8 @@ SPEC is a predicate specifier that contains stuff like `or', `and', | |||
| 1397 | ;; Make sure iswitchb is loaded before we let-bind its variables. | 1391 | ;; Make sure iswitchb is loaded before we let-bind its variables. |
| 1398 | ;; If it is loaded inside the let, variables can become unbound afterwards. | 1392 | ;; If it is loaded inside the let, variables can become unbound afterwards. |
| 1399 | (require 'iswitchb) | 1393 | (require 'iswitchb) |
| 1394 | (declare-function iswitchb-minibuffer-setup "iswitchb" ()) | ||
| 1395 | (defvar iswitchb-make-buflist-hook) | ||
| 1400 | (let ((iswitchb-make-buflist-hook | 1396 | (let ((iswitchb-make-buflist-hook |
| 1401 | (lambda () | 1397 | (lambda () |
| 1402 | (setq iswitchb-temp-buflist | 1398 | (setq iswitchb-temp-buflist |
| @@ -1410,16 +1406,14 @@ SPEC is a predicate specifier that contains stuff like `or', `and', | |||
| 1410 | (unwind-protect | 1406 | (unwind-protect |
| 1411 | (progn | 1407 | (progn |
| 1412 | (or iswitchb-mode | 1408 | (or iswitchb-mode |
| 1413 | (add-hook 'minibuffer-setup-hook 'iswitchb-minibuffer-setup)) | 1409 | (add-hook 'minibuffer-setup-hook #'iswitchb-minibuffer-setup)) |
| 1414 | (iswitchb-read-buffer prompt def require-match)) | 1410 | (iswitchb-read-buffer prompt def require-match)) |
| 1415 | (or iswitchb-mode | 1411 | (or iswitchb-mode |
| 1416 | (remove-hook 'minibuffer-setup-hook 'iswitchb-minibuffer-setup))))) | 1412 | (remove-hook 'minibuffer-setup-hook #'iswitchb-minibuffer-setup))))) |
| 1417 | |||
| 1418 | (put 'gnus-parse-without-error 'lisp-indent-function 0) | ||
| 1419 | (put 'gnus-parse-without-error 'edebug-form-spec '(body)) | ||
| 1420 | 1413 | ||
| 1421 | (defmacro gnus-parse-without-error (&rest body) | 1414 | (defmacro gnus-parse-without-error (&rest body) |
| 1422 | "Allow continuing onto the next line even if an error occurs." | 1415 | "Allow continuing onto the next line even if an error occurs." |
| 1416 | (declare (indent 0) (debug (body))) | ||
| 1423 | `(while (not (eobp)) | 1417 | `(while (not (eobp)) |
| 1424 | (condition-case () | 1418 | (condition-case () |
| 1425 | (progn | 1419 | (progn |
| @@ -1510,18 +1504,17 @@ Return nil otherwise." | |||
| 1510 | 1504 | ||
| 1511 | (defvar tool-bar-mode) | 1505 | (defvar tool-bar-mode) |
| 1512 | 1506 | ||
| 1513 | (defun gnus-tool-bar-update (&rest ignore) | 1507 | (defun gnus-tool-bar-update (&rest _) |
| 1514 | "Update the tool bar." | 1508 | "Update the tool bar." |
| 1515 | (when (and (boundp 'tool-bar-mode) | 1509 | (when (bound-and-true-p tool-bar-mode) |
| 1516 | tool-bar-mode) | ||
| 1517 | (let* ((args nil) | 1510 | (let* ((args nil) |
| 1518 | (func (cond ((fboundp 'tool-bar-update) | 1511 | (func (cond ((fboundp 'tool-bar-update) |
| 1519 | 'tool-bar-update) | 1512 | #'tool-bar-update) |
| 1520 | ((fboundp 'force-window-update) | 1513 | ((fboundp 'force-window-update) |
| 1521 | 'force-window-update) | 1514 | #'force-window-update) |
| 1522 | ((fboundp 'redraw-frame) | 1515 | ((fboundp 'redraw-frame) |
| 1523 | (setq args (list (selected-frame))) | 1516 | (setq args (list (selected-frame))) |
| 1524 | 'redraw-frame) | 1517 | #'redraw-frame) |
| 1525 | (t 'ignore)))) | 1518 | (t 'ignore)))) |
| 1526 | (apply func args)))) | 1519 | (apply func args)))) |
| 1527 | 1520 | ||
| @@ -1536,7 +1529,7 @@ sequence, this is like `mapcar'. With several, it is like the Common Lisp | |||
| 1536 | (if seqs2_n | 1529 | (if seqs2_n |
| 1537 | (let* ((seqs (cons seq1 seqs2_n)) | 1530 | (let* ((seqs (cons seq1 seqs2_n)) |
| 1538 | (cnt 0) | 1531 | (cnt 0) |
| 1539 | (heads (mapcar (lambda (seq) | 1532 | (heads (mapcar (lambda (_seq) |
| 1540 | (make-symbol (concat "head" | 1533 | (make-symbol (concat "head" |
| 1541 | (int-to-string | 1534 | (int-to-string |
| 1542 | (setq cnt (1+ cnt)))))) | 1535 | (setq cnt (1+ cnt)))))) |
| @@ -1569,8 +1562,7 @@ sequence, this is like `mapcar'. With several, it is like the Common Lisp | |||
| 1569 | system-configuration) | 1562 | system-configuration) |
| 1570 | ((memq 'type lst) | 1563 | ((memq 'type lst) |
| 1571 | (symbol-name system-type)) | 1564 | (symbol-name system-type)) |
| 1572 | (t nil))) | 1565 | (t nil)))) |
| 1573 | codename) | ||
| 1574 | (cond | 1566 | (cond |
| 1575 | ((not (memq 'emacs lst)) | 1567 | ((not (memq 'emacs lst)) |
| 1576 | nil) | 1568 | nil) |
| @@ -1586,9 +1578,7 @@ sequence, this is like `mapcar'. With several, it is like the Common Lisp | |||
| 1586 | empty directories from OLD-PATH." | 1578 | empty directories from OLD-PATH." |
| 1587 | (when (file-exists-p old-path) | 1579 | (when (file-exists-p old-path) |
| 1588 | (let* ((old-dir (file-name-directory old-path)) | 1580 | (let* ((old-dir (file-name-directory old-path)) |
| 1589 | (old-name (file-name-nondirectory old-path)) | ||
| 1590 | (new-dir (file-name-directory new-path)) | 1581 | (new-dir (file-name-directory new-path)) |
| 1591 | (new-name (file-name-nondirectory new-path)) | ||
| 1592 | temp) | 1582 | temp) |
| 1593 | (gnus-make-directory new-dir) | 1583 | (gnus-make-directory new-dir) |
| 1594 | (rename-file old-path new-path t) | 1584 | (rename-file old-path new-path t) |
| @@ -1693,7 +1683,7 @@ lists of strings." | |||
| 1693 | (setq props (plist-put props :foreground (face-foreground face))) | 1683 | (setq props (plist-put props :foreground (face-foreground face))) |
| 1694 | (setq props (plist-put props :background (face-background face)))) | 1684 | (setq props (plist-put props :background (face-background face)))) |
| 1695 | (ignore-errors | 1685 | (ignore-errors |
| 1696 | (apply 'create-image file type data-p props)))) | 1686 | (apply #'create-image file type data-p props)))) |
| 1697 | 1687 | ||
| 1698 | (defun gnus-put-image (glyph &optional string category) | 1688 | (defun gnus-put-image (glyph &optional string category) |
| 1699 | (let ((point (point))) | 1689 | (let ((point (point))) |
diff --git a/lisp/gnus/nnimap.el b/lisp/gnus/nnimap.el index 9e52abc1ca7..760bcc2293d 100644 --- a/lisp/gnus/nnimap.el +++ b/lisp/gnus/nnimap.el | |||
| @@ -1,4 +1,4 @@ | |||
| 1 | ;;; nnimap.el --- IMAP interface for Gnus | 1 | ;;; nnimap.el --- IMAP interface for Gnus -*- lexical-binding:t -*- |
| 2 | 2 | ||
| 3 | ;; Copyright (C) 2010-2019 Free Software Foundation, Inc. | 3 | ;; Copyright (C) 2010-2019 Free Software Foundation, Inc. |
| 4 | 4 | ||