summaryrefslogtreecommitdiff
path: root/lisp/gnus
diff options
context:
space:
mode:
authorStefan Monnier <monnier@iro.umontreal.ca>2019-06-26 10:03:48 -0400
committerStefan Monnier <monnier@iro.umontreal.ca>2019-06-26 10:03:48 -0400
commit698ff554ac2699ec48fefc85a1307cbc4a183b0d (patch)
treea7b7592f7973f81cad4410366d313e790616907e /lisp/gnus
parent9233865b7005831e63755eb84ae7da060f878a55 (diff)
downloademacs-698ff554ac2699ec48fefc85a1307cbc4a183b0d.tar.gz
* lisp/calc/calc-ext.el (math-scalarp): Fix typo
Diffstat (limited to 'lisp/gnus')
-rw-r--r--lisp/gnus/gnus-art.el284
-rw-r--r--lisp/gnus/gnus-cloud.el10
-rw-r--r--lisp/gnus/gnus-topic.el9
-rw-r--r--lisp/gnus/gnus-util.el114
-rw-r--r--lisp/gnus/nnimap.el2
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."
:group 'gnus-article
:type 'boolean)
-(defcustom gnus-blocked-images 'gnus-block-private-groups
+(defcustom gnus-blocked-images #'gnus-block-private-groups
"Images that have URLs matching this regexp will be blocked.
Note that the main reason external images are included in HTML
emails (these days) is to allow tracking whether you've read the
@@ -2693,7 +2693,7 @@ If READ-CHARSET, ask for a coding system."
"Format an HTML article."
(interactive)
(let ((handles nil)
- (buffer-read-only nil))
+ (inhibit-read-only t))
(when (gnus-buffer-live-p gnus-original-article-buffer)
(with-current-buffer gnus-original-article-buffer
(setq handles (mm-dissect-buffer t t))))
@@ -4302,71 +4302,67 @@ If variable `gnus-use-long-file-name' is non-nil, it is
(canlock-verify gnus-original-article-buffer)))
(eval-and-compile
- (mapc
- (lambda (func)
- (let (afunc gfunc)
- (if (consp func)
- (setq afunc (car func)
- gfunc (cdr func))
- (setq afunc func
- gfunc (intern (format "gnus-%s" func))))
- (defalias gfunc
- (when (fboundp afunc)
- `(lambda (&optional interactive &rest args)
- ,(documentation afunc t)
- (interactive (list t))
- (with-current-buffer gnus-article-buffer
- (if interactive
- (call-interactively ',afunc)
- (apply #',afunc args))))))))
- '(article-hide-headers
- article-verify-x-pgp-sig
- article-verify-cancel-lock
- article-hide-boring-headers
- article-treat-overstrike
- article-treat-ansi-sequences
- article-fill-long-lines
- article-capitalize-sentences
- article-remove-cr
- article-remove-leading-whitespace
- article-display-x-face
- article-display-face
- article-de-quoted-unreadable
- article-de-base64-unreadable
- article-decode-HZ
- article-wash-html
- article-unsplit-urls
- article-hide-list-identifiers
- article-strip-banner
- article-babel
- article-hide-pem
- article-hide-signature
- article-strip-headers-in-body
- article-remove-trailing-blank-lines
- article-strip-leading-blank-lines
- article-strip-multiple-blank-lines
- article-strip-leading-space
- article-strip-trailing-space
- article-strip-blank-lines
- article-strip-all-blank-lines
- article-date-local
- article-date-english
- article-date-iso8601
- article-date-original
- article-treat-date
- article-date-ut
- article-decode-mime-words
- article-decode-charset
- article-decode-encoded-words
- article-date-user
- article-date-lapsed
- article-date-combined-lapsed
- article-emphasize
- article-treat-dumbquotes
- article-treat-non-ascii
- article-normalize-headers
- ;;(article-show-all . gnus-article-show-all-headers)
- )))
+ (defmacro gnus-art-defun (gnus-fun &optional article-fun)
+ "Define GNUS-FUN as a function that runs ARTICLE-FUN in the article buffer."
+ (unless article-fun
+ (if (not (string-match "\\`gnus-" (symbol-name gnus-fun)))
+ (error "Can't guess article-fun argument")
+ (setq article-fun (intern (substring (symbol-name gnus-fun)
+ (match-end 0))))))
+ `(defun ,gnus-fun (&optional interactive &rest args)
+ ,(format "Run `%s' in the article buffer." article-fun)
+ (interactive (list t))
+ (with-current-buffer gnus-article-buffer
+ (if interactive
+ (call-interactively ',article-fun)
+ (apply #',article-fun args))))))
+(gnus-art-defun gnus-article-hide-headers)
+(gnus-art-defun gnus-article-verify-x-pgp-sig)
+(gnus-art-defun gnus-article-verify-cancel-lock)
+(gnus-art-defun gnus-article-hide-boring-headers)
+(gnus-art-defun gnus-article-treat-overstrike)
+(gnus-art-defun gnus-article-treat-ansi-sequences)
+(gnus-art-defun gnus-article-fill-long-lines)
+(gnus-art-defun gnus-article-capitalize-sentences)
+(gnus-art-defun gnus-article-remove-cr)
+(gnus-art-defun gnus-article-remove-leading-whitespace)
+(gnus-art-defun gnus-article-display-x-face)
+(gnus-art-defun gnus-article-display-face)
+(gnus-art-defun gnus-article-de-quoted-unreadable)
+(gnus-art-defun gnus-article-de-base64-unreadable)
+(gnus-art-defun gnus-article-decode-HZ)
+(gnus-art-defun gnus-article-wash-html)
+(gnus-art-defun gnus-article-unsplit-urls)
+(gnus-art-defun gnus-article-hide-list-identifiers)
+(gnus-art-defun gnus-article-strip-banner)
+(gnus-art-defun gnus-article-babel)
+(gnus-art-defun gnus-article-hide-pem)
+(gnus-art-defun gnus-article-hide-signature)
+(gnus-art-defun gnus-article-strip-headers-in-body)
+(gnus-art-defun gnus-article-remove-trailing-blank-lines)
+(gnus-art-defun gnus-article-strip-leading-blank-lines)
+(gnus-art-defun gnus-article-strip-multiple-blank-lines)
+(gnus-art-defun gnus-article-strip-leading-space)
+(gnus-art-defun gnus-article-strip-trailing-space)
+(gnus-art-defun gnus-article-strip-blank-lines)
+(gnus-art-defun gnus-article-strip-all-blank-lines)
+(gnus-art-defun gnus-article-date-local)
+(gnus-art-defun gnus-article-date-english)
+(gnus-art-defun gnus-article-date-iso8601)
+(gnus-art-defun gnus-article-date-original)
+(gnus-art-defun gnus-article-treat-date)
+(gnus-art-defun gnus-article-date-ut)
+(gnus-art-defun gnus-article-decode-mime-words)
+(gnus-art-defun gnus-article-decode-charset)
+(gnus-art-defun gnus-article-decode-encoded-words)
+(gnus-art-defun gnus-article-date-user)
+(gnus-art-defun gnus-article-date-lapsed)
+(gnus-art-defun gnus-article-date-combined-lapsed)
+(gnus-art-defun gnus-article-emphasize)
+(gnus-art-defun gnus-article-treat-dumbquotes)
+(gnus-art-defun gnus-article-treat-non-ascii)
+(gnus-art-defun gnus-article-normalize-headers)
+;;(gnus-art-defun gnus-article-show-all-headers article-show-all)
;;;
;;; Gnus article mode
@@ -4869,17 +4865,18 @@ General format specifiers can also be used. See Info node
(defvar gnus-mime-button-map
(let ((map (make-sparse-keymap)))
(define-key map [mouse-2] 'gnus-article-push-button)
- (define-key map [down-mouse-3] 'gnus-mime-button-menu)
(dolist (c gnus-mime-button-commands)
(define-key map (cadr c) (car c)))
- map))
-(easy-menu-define
- gnus-mime-button-menu gnus-mime-button-map "MIME button menu."
- `("MIME Part"
- ,@(mapcar (lambda (c)
- (vector (caddr c) (car c) :active t))
- gnus-mime-button-commands)))
+ (easy-menu-define gnus-mime-button-menu map "MIME button menu."
+ `("MIME Part"
+ ,@(mapcar (lambda (c)
+ (vector (caddr c) (car c) :active t))
+ gnus-mime-button-commands)))
+
+ (define-key map [down-mouse-3]
+ (easy-menu-binding gnus-mime-button-menu))
+ map))
(defvar gnus-url-button-commands
'((gnus-article-copy-string "u" "Copy URL to kill ring")))
@@ -4923,16 +4920,6 @@ General format specifiers can also be used. See Info node
(setq mm-w3m-safe-url-regexp nil)))
,@body))
-(defun gnus-mime-button-menu (event prefix)
- "Construct a context-sensitive menu of MIME commands."
- (interactive "e\nP")
- (save-window-excursion
- (let ((pos (event-start event)))
- (select-window (posn-window pos))
- (goto-char (posn-point pos))
- (gnus-article-check-buffer)
- (popup-menu gnus-mime-button-menu nil prefix))))
-
(defun gnus-mime-view-all-parts (&optional handles)
"View all the MIME parts."
(interactive)
@@ -5055,10 +5042,12 @@ and `gnus-mime-delete-part', and not provided at run-time normally."
nil nil)))
(gnus-mime-save-part-and-strip file))
-(defun gnus-mime-save-part-and-strip (&optional file)
+(defun gnus-mime-save-part-and-strip (&optional file event)
"Save the MIME part under point then replace it with an external body.
If FILE is given, use it for the external part."
- (interactive)
+ (interactive (list nil last-nonmenu-event))
+ (save-excursion
+ (mouse-set-point event)
(gnus-article-check-buffer)
(when (gnus-group-read-only-p)
(error "The current group does not support deleting of parts"))
@@ -5090,15 +5079,16 @@ The current article has a complicated MIME structure, giving up..."))
(access-type . "LOCAL-FILE")
(name . ,file)))))
;; (set-buffer gnus-summary-buffer)
- (gnus-article-edit-part handles id))))
+ (gnus-article-edit-part handles id)))))
;; A function like `gnus-summary-save-parts' (`X m', `<MIME> <Extract all
;; parts...>') but with stripping would be nice.
-(defun gnus-mime-delete-part ()
+(defun gnus-mime-delete-part (&optional event)
"Delete the MIME part under point.
Replace it with some information about the removed part."
- (interactive)
+ (interactive (list last-nonmenu-event))
+ (mouse-set-point event)
(gnus-article-check-buffer)
(when (gnus-group-read-only-p)
(error "The current group does not support deleting of parts"))
@@ -5144,33 +5134,36 @@ Deleting parts may malfunction or destroy the article; continue? "))
;; (set-buffer gnus-summary-buffer)
(gnus-article-edit-part handles id))))
-(defun gnus-mime-save-part ()
+(defun gnus-mime-save-part (&optional event)
"Save the MIME part under point."
- (interactive)
+ (interactive (list last-nonmenu-event))
+ (mouse-set-point event)
(gnus-article-check-buffer)
(let ((data (get-text-property (point) 'gnus-data)))
(when data
(mm-save-part data))))
-(defun gnus-mime-pipe-part (&optional cmd)
- "Pipe the MIME part under point to a process.
-Use CMD as the process."
- (interactive)
+(defun gnus-mime-pipe-part (&optional cmd event)
+ "Pipe the MIME part under point to a process."
+ (interactive (list nil last-nonmenu-event))
+ (mouse-set-point event)
(gnus-article-check-buffer)
(let ((data (get-text-property (point) 'gnus-data)))
(when data
(mm-pipe-part data cmd))))
-(defun gnus-mime-view-part ()
+(defun gnus-mime-view-part (&optional event)
"Interactively choose a viewing method for the MIME part under point."
- (interactive)
- (gnus-article-check-buffer)
- (let ((data (get-text-property (point) 'gnus-data)))
- (when data
- (setq gnus-article-mime-handles
- (mm-merge-handles
- gnus-article-mime-handles (setq data (copy-sequence data))))
- (mm-interactively-view-part data))))
+ (interactive (list last-nonmenu-event))
+ (save-excursion
+ (mouse-set-point event)
+ (gnus-article-check-buffer)
+ (let ((data (get-text-property (point) 'gnus-data)))
+ (when data
+ (setq gnus-article-mime-handles
+ (mm-merge-handles
+ gnus-article-mime-handles (setq data (copy-sequence data))))
+ (mm-interactively-view-part data)))))
(defun gnus-mime-view-part-as-type-internal ()
(gnus-article-check-buffer)
@@ -5187,11 +5180,13 @@ Use CMD as the process."
'("text/plain" . 0))
'("application/octet-stream" . 0))))
-(defun gnus-mime-view-part-as-type (&optional mime-type pred)
+(defun gnus-mime-view-part-as-type (&optional mime-type pred event)
"Choose a MIME media type, and view the part as such.
If non-nil, PRED is a predicate to use during completion to limit the
available media-types."
- (interactive)
+ (interactive (list nil nil last-nonmenu-event))
+ (save-excursion
+ (if event (mouse-set-point event))
(unless mime-type
(setq mime-type
(let ((default (gnus-mime-view-part-as-type-internal)))
@@ -5222,13 +5217,14 @@ available media-types."
(mm-merge-handles gnus-article-mime-handles handle))
(when (mm-handle-displayed-p handle)
(mm-remove-part handle))
- (gnus-mm-display-part handle))))
+ (gnus-mm-display-part handle)))))
-(defun gnus-mime-copy-part (&optional handle arg)
+(defun gnus-mime-copy-part (&optional handle arg event)
"Put the MIME part under point into a new buffer.
If `auto-compression-mode' is enabled, compressed files like .gz and .bz2
are decompressed."
- (interactive (list nil current-prefix-arg))
+ (interactive (list nil current-prefix-arg last-nonmenu-event))
+ (mouse-set-point event)
(gnus-article-check-buffer)
(unless handle
(setq handle (get-text-property (point) 'gnus-data)))
@@ -5280,9 +5276,12 @@ are decompressed."
(setq buffer-file-name nil))
(goto-char (point-min)))))
-(defun gnus-mime-print-part (&optional handle filename)
+(defun gnus-mime-print-part (&optional handle filename event)
"Print the MIME part under point."
- (interactive (list nil (ps-print-preprint current-prefix-arg)))
+ (interactive
+ (list nil (ps-print-preprint current-prefix-arg) last-nonmenu-event))
+ (save-excursion
+ (mouse-set-point event)
(gnus-article-check-buffer)
(let* ((handle (or handle (get-text-property (point) 'gnus-data)))
(contents (and handle (mm-get-part handle)))
@@ -5303,12 +5302,13 @@ are decompressed."
(with-temp-buffer
(insert contents)
(gnus-print-buffer))
- (ps-despool filename)))))
+ (ps-despool filename))))))
-(defun gnus-mime-inline-part (&optional handle arg)
+(defun gnus-mime-inline-part (&optional handle arg event)
"Insert the MIME part under point into the current buffer.
Compressed files like .gz and .bz2 are decompressed."
- (interactive (list nil current-prefix-arg))
+ (interactive (list nil current-prefix-arg last-nonmenu-event))
+ (if event (mouse-set-point event))
(gnus-article-check-buffer)
(let* ((inhibit-read-only t)
(b (point))
@@ -5402,10 +5402,12 @@ CHARSET may either be a string or a symbol."
(setcdr param charset)
(setcdr type (cons (cons 'charset charset) (cdr type)))))))
-(defun gnus-mime-view-part-as-charset (&optional handle arg)
+(defun gnus-mime-view-part-as-charset (&optional handle arg event)
"Insert the MIME part under point into the current buffer using the
specified charset."
- (interactive (list nil current-prefix-arg))
+ (interactive (list nil current-prefix-arg last-nonmenu-event))
+ (save-excursion
+ (mouse-set-point event)
(gnus-article-check-buffer)
(let ((handle (or handle (get-text-property (point) 'gnus-data)))
(fun (get-text-property (point) 'gnus-callback))
@@ -5439,11 +5441,13 @@ specified charset."
(setcar (cddr form)
(list 'quote (or (cadr (member preferred parts))
(car parts)))))
- (funcall fun handle)))))
+ (funcall fun handle))))))
-(defun gnus-mime-view-part-externally (&optional handle)
+(defun gnus-mime-view-part-externally (&optional handle event)
"View the MIME part under point with an external viewer."
- (interactive)
+ (interactive (list nil last-nonmenu-event))
+ (save-excursion
+ (mouse-set-point event)
(gnus-article-check-buffer)
(let* ((handle (or handle (get-text-property (point) 'gnus-data)))
(mm-inlined-types nil)
@@ -5458,12 +5462,14 @@ specified charset."
(gnus-mime-view-part-as-type
nil (lambda (type) (stringp (mailcap-mime-info type))))
(when handle
- (mm-display-part handle nil t)))))
+ (mm-display-part handle nil t))))))
-(defun gnus-mime-view-part-internally (&optional handle)
+(defun gnus-mime-view-part-internally (&optional handle event)
"View the MIME part under point with an internal viewer.
If no internal viewer is available, use an external viewer."
- (interactive)
+ (interactive (list nil last-nonmenu-event))
+ (save-excursion
+ (mouse-set-point event)
(gnus-article-check-buffer)
(let* ((handle (or handle (get-text-property (point) 'gnus-data)))
(mm-inlined-types '(".*"))
@@ -5477,7 +5483,7 @@ If no internal viewer is available, use an external viewer."
(gnus-mime-view-part-as-type
nil (lambda (type) (mm-inlinable-p handle type)))
(when handle
- (gnus-bind-mm-vars (mm-display-part handle nil t))))))
+ (gnus-bind-mm-vars (mm-display-part handle nil t)))))))
(defun gnus-mime-action-on-part (&optional action)
"Do something with the MIME attachment at (point)."
@@ -5849,7 +5855,7 @@ all parts."
(widget-convert-button
'link b e
:mime-handle handle
- :action 'gnus-widget-press-button
+ :action #'gnus-widget-press-button
:button-keymap gnus-mime-button-map
:help-echo
(lambda (widget)
@@ -6148,7 +6154,7 @@ If nil, don't show those extra buttons."
article-type multipart
rear-nonsticky t))
(widget-convert-button 'link from (point)
- :action 'gnus-widget-press-button)
+ :action #'gnus-widget-press-button)
;; Do the handles
(while (setq handle (pop handles))
(add-text-properties
@@ -6172,7 +6178,7 @@ If nil, don't show those extra buttons."
gnus-data ,handle
rear-nonsticky t))
(widget-convert-button 'link from (point)
- :action 'gnus-widget-press-button)
+ :action #'gnus-widget-press-button)
(insert " "))
(insert "\n\n"))
(when preferred
@@ -7115,13 +7121,11 @@ If given a prefix, show the hidden text instead."
(when (and do-update-line
(or (numberp article)
(stringp article)))
- (let ((buf (current-buffer)))
- (set-buffer gnus-summary-buffer)
+ (with-current-buffer gnus-summary-buffer
(gnus-summary-update-article do-update-line sparse-header)
(gnus-summary-goto-subject do-update-line nil t)
(set-window-point (gnus-get-buffer-window (current-buffer) t)
- (point))
- (set-buffer buf))))))
+ (point)))))))
(defun gnus-block-private-groups (group)
"Allows images in newsgroups to be shown, blocks images in all
@@ -7316,8 +7320,7 @@ groups."
(gnus-article-mode)
(set-window-configuration winconf)
;; Tippy-toe some to make sure that point remains where it was.
- (save-current-buffer
- (set-buffer curbuf)
+ (with-current-buffer curbuf
(set-window-start (get-buffer-window (current-buffer)) window-start)
(goto-char p))))
(gnus-summary-show-article)))
@@ -7869,15 +7872,16 @@ call it with the value of the `gnus-data' text property."
(when fun
(funcall fun data))))
-(defun gnus-article-press-button ()
+(defun gnus-article-press-button (&optional event)
"Check text at point for a callback function.
If the text at point has a `gnus-callback' property,
call it with the value of the `gnus-data' text property."
- (interactive)
- (let ((data (get-text-property (point) 'gnus-data))
- (fun (get-text-property (point) 'gnus-callback)))
- (when fun
- (funcall fun data))))
+ (interactive (list last-nonmenu-event))
+ (save-excursion
+ (mouse-set-point event)
+ (let ((fun (get-text-property (point) 'gnus-callback)))
+ (when fun
+ (funcall fun (get-text-property (point) 'gnus-data))))))
(defun gnus-article-highlight (&optional force)
"Highlight current article.
@@ -8095,7 +8099,7 @@ url is put as the `gnus-button-url' overlay property on the button."
(list 'mouse-face gnus-article-mouse-face))
(list 'gnus-callback fun)
(and data (list 'gnus-data data))))
- (widget-convert-button 'link from to :action 'gnus-widget-press-button
+ (widget-convert-button 'link from to :action #'gnus-widget-press-button
:help-echo (or text "Follow the link")
:keymap gnus-url-button-map))
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 @@
-;;; gnus-cloud.el --- storing and retrieving data via IMAP
+;;; gnus-cloud.el --- storing and retrieving data via IMAP -*- lexical-binding:t -*-
;; Copyright (C) 2014-2019 Free Software Foundation, Inc.
@@ -52,14 +52,12 @@ Each element may be either a string or a property list.
The latter should have a :directory element whose value is a string,
and a :match element whose value is a regular expression to match
against the basename of files in said directory."
- :group 'gnus-cloud
:type '(repeat (choice (string :tag "File")
(plist :tag "Property list"))))
(defcustom gnus-cloud-storage-method (if (featurep 'epg) 'epg 'base64-gzip)
"Storage method for cloud data, defaults to EPG if that's available."
:version "26.1"
- :group 'gnus-cloud
:type '(radio (const :tag "No encoding" nil)
(const :tag "Base64" base64)
(const :tag "Base64+gzip" base64-gzip)
@@ -68,7 +66,6 @@ against the basename of files in said directory."
(defcustom gnus-cloud-interactive t
"Whether Gnus Cloud changes should be confirmed."
:version "26.1"
- :group 'gnus-cloud
:type 'boolean)
(defvar gnus-cloud-group-name "Emacs-Cloud")
@@ -81,7 +78,6 @@ against the basename of files in said directory."
"The IMAP select method used to store the cloud data.
See also `gnus-server-set-cloud-method-server' for an
easy interactive way to set this from the Server buffer."
- :group 'gnus-cloud
:type '(radio (const :tag "Not set" nil)
(string :tag "A Gnus server name as a string")))
@@ -131,8 +127,7 @@ easy interactive way to set this from the Server buffer."
(base64-encode-region (point-min) (point-max)))
((eq gnus-cloud-storage-method 'epg)
- (let ((context (epg-make-context 'OpenPGP))
- cipher)
+ (let ((context (epg-make-context 'OpenPGP)))
(setf (epg-context-armor context) t)
(setf (epg-context-textmode context) t)
(let ((data (epg-encrypt-string context
@@ -353,6 +348,7 @@ Use old data if FORCE-OLDER is not nil."
(group &optional previous method))
(defun gnus-cloud-ensure-cloud-group ()
+ ;; FIXME: `method' is not used!?
(let ((method (if (stringp gnus-cloud-method)
(gnus-server-to-method gnus-cloud-method)
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."
(add-text-properties
(point)
(prog1 (1+ (point))
- (eval gnus-topic-line-format-spec))
+ (eval gnus-topic-line-format-spec
+ `((indentation . ,indentation)
+ (visible . ,visible)
+ (name . ,name)
+ (level . ,level)
+ (number-of-groups . ,number-of-groups)
+ (total-number-of-articles . ,total-number-of-articles)
+ (entries . ,entries))))
(list 'gnus-topic name
'gnus-topic-level level
'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 @@
(require 'time-date)
(require 'text-property-search)
-(defcustom gnus-completing-read-function 'gnus-emacs-completing-read
+(defcustom gnus-completing-read-function #'gnus-emacs-completing-read
"Function use to do completing read."
:version "24.1"
:group 'gnus-meta
@@ -87,6 +87,7 @@ This is a compatibility function for different Emacsen."
(defmacro gnus-eval-in-buffer-window (buffer &rest forms)
"Pop to BUFFER, evaluate FORMS, and then return to the original window."
+ (declare (indent 1) (debug (form body)))
(let ((tempvar (make-symbol "GnusStartBufferWindow"))
(w (make-symbol "w"))
(buf (make-symbol "buf")))
@@ -103,9 +104,6 @@ This is a compatibility function for different Emacsen."
,@forms)
(select-window ,tempvar)))))
-(put 'gnus-eval-in-buffer-window 'lisp-indent-function 1)
-(put 'gnus-eval-in-buffer-window 'edebug-form-spec '(form body))
-
(defsubst gnus-goto-char (point)
(and point (goto-char point)))
@@ -302,26 +300,24 @@ Symbols are also allowed; their print names are used instead."
(defmacro gnus-local-set-keys (&rest plist)
"Set the keys in PLIST in the current keymap."
+ (declare (indent 1))
`(gnus-define-keys-1 (current-local-map) ',plist))
(defmacro gnus-define-keys (keymap &rest plist)
"Define all keys in PLIST in KEYMAP."
+ (declare (indent 1))
`(gnus-define-keys-1 (quote ,keymap) (quote ,plist)))
(defmacro gnus-define-keys-safe (keymap &rest plist)
"Define all keys in PLIST in KEYMAP without overwriting previous definitions."
+ (declare (indent 1))
`(gnus-define-keys-1 (quote ,keymap) (quote ,plist) t))
-(put 'gnus-define-keys 'lisp-indent-function 1)
-(put 'gnus-define-keys-safe 'lisp-indent-function 1)
-(put 'gnus-local-set-keys 'lisp-indent-function 1)
-
(defmacro gnus-define-keymap (keymap &rest plist)
"Define all keys in PLIST in KEYMAP."
+ (declare (indent 1))
`(gnus-define-keys-1 ,keymap (quote ,plist)))
-(put 'gnus-define-keymap 'lisp-indent-function 1)
-
(defun gnus-define-keys-1 (keymap plist &optional safe)
(when (null keymap)
(error "Can't set keys in a null keymap"))
@@ -444,7 +440,7 @@ displayed in the echo area."
`(let (str time)
(cond ((eq gnus-add-timestamp-to-message 'log)
(setq str (let (message-log-max)
- (apply 'message ,format-string ,args)))
+ (apply #'message ,format-string ,args)))
(when (and message-log-max
(> message-log-max 0)
(/= (length str) 0))
@@ -462,7 +458,7 @@ displayed in the echo area."
(gnus-add-timestamp-to-message
(if (or (and (null ,format-string) (null ,args))
(progn
- (setq str (apply 'format ,format-string ,args))
+ (setq str (apply #'format ,format-string ,args))
(zerop (length str))))
(prog1
(and ,format-string str)
@@ -471,7 +467,7 @@ displayed in the echo area."
(message "%s" (concat ,timestamp str))
str))
(t
- (apply 'message ,format-string ,args)))))))
+ (apply #'message ,format-string ,args)))))))
(defvar gnus-action-message-log nil)
@@ -490,9 +486,10 @@ that take a long time, 7 - not very important messages on stuff, 9 - messages
inside loops."
(if (<= level gnus-verbose)
(let ((message
- (if gnus-add-timestamp-to-message
- (apply 'gnus-message-with-timestamp args)
- (apply 'message args))))
+ (apply (if gnus-add-timestamp-to-message
+ #'gnus-message-with-timestamp
+ #'message)
+ args)))
(when (and (consp gnus-action-message-log)
(<= level 3))
(push message gnus-action-message-log))
@@ -500,7 +497,7 @@ inside loops."
;; We have to do this format thingy here even if the result isn't
;; shown - the return value has to be the same as the return value
;; from `message'.
- (apply 'format args)))
+ (apply #'format args)))
(defun gnus-final-warning ()
(when (and (consp gnus-action-message-log)
@@ -513,7 +510,7 @@ inside loops."
"Beep an error if LEVEL is equal to or less than `gnus-verbose'.
ARGS are passed to `message'."
(when (<= (floor level) gnus-verbose)
- (apply 'message args)
+ (apply #'message args)
(ding)
(let (duration)
(when (and (floatp level)
@@ -688,18 +685,20 @@ Lisp objects are loadable. Bind `print-quoted' and `print-readably'
to t, and `print-escape-multibyte', `print-escape-newlines',
`print-escape-nonascii', `print-length', `print-level' and
`print-string-length' to nil."
- `(let ((print-quoted t)
- (print-readably t)
- ;;print-circle
- ;;print-continuous-numbering
- print-escape-multibyte
- print-escape-newlines
- print-escape-nonascii
- ;;print-gensym
- print-length
- print-level
- print-string-length)
- ,@forms))
+ `(progn
+ (defvar print-string-length) (defvar print-readably)
+ (let ((print-quoted t)
+ (print-readably t)
+ ;;print-circle
+ ;;print-continuous-numbering
+ print-escape-multibyte
+ print-escape-newlines
+ print-escape-nonascii
+ ;;print-gensym
+ print-length
+ print-level
+ print-string-length)
+ ,@forms)))
(defun gnus-prin1 (form)
"Use `prin1' on FORM in the current buffer.
@@ -852,11 +851,10 @@ the user are disabled, it is recommended that only the most minimal
operations are performed by FORMS. If you wish to assign many
complicated values atomically, compute the results into temporary
variables and then do only the assignment atomically."
+ (declare (indent 0))
`(let ((inhibit-quit gnus-atomic-be-safe))
,@forms))
-(put 'gnus-atomic-progn 'lisp-indent-function 0)
-
(defmacro gnus-atomic-progn-assign (protect &rest forms)
"Evaluate FORMS, but ensure that the variables listed in PROTECT
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.
Note that if any of the symbols in PROTECT were unbound, they will be
set to nil on a successful assignment. In case of an error or other
non-local exit, it will still be unbound."
+ (declare (indent 1)) ;;(debug (sexp body))
(let* ((temp-sym-map (mapcar (lambda (x) (list (make-symbol
(concat (symbol-name x)
"-tmp"))
@@ -878,8 +877,8 @@ non-local exit, it will still be unbound."
,(cadr x))))
temp-sym-map))
(sym-temp-let sym-temp-map)
- (temp-sym-assign (apply 'append temp-sym-map))
- (sym-temp-assign (apply 'append sym-temp-map))
+ (temp-sym-assign (apply #'append temp-sym-map))
+ (sym-temp-assign (apply #'append sym-temp-map))
(result (make-symbol "result-tmp")))
`(let (,@temp-sym-let
,result)
@@ -890,9 +889,6 @@ non-local exit, it will still be unbound."
(setq ,@sym-temp-assign))
,result)))
-(put 'gnus-atomic-progn-assign 'lisp-indent-function 1)
-;(put 'gnus-atomic-progn-assign 'edebug-form-spec '(sexp body))
-
(defmacro gnus-atomic-setq (&rest pairs)
"Similar to setq, except that the real symbols are only assigned when
there are no errors. And when the real symbols are assigned, they are
@@ -1102,16 +1098,16 @@ ARG is passed to the first function."
(defun gnus-run-hooks (&rest funcs)
"Does the same as `run-hooks', but saves the current buffer."
(save-current-buffer
- (apply 'run-hooks funcs)))
+ (apply #'run-hooks funcs)))
(defun gnus-run-hook-with-args (hook &rest args)
"Does the same as `run-hook-with-args', but saves the current buffer."
(save-current-buffer
- (apply 'run-hook-with-args hook args)))
+ (apply #'run-hook-with-args hook args)))
(defun gnus-run-mode-hooks (&rest funcs)
"Run `run-mode-hooks', saving the current buffer."
- (save-current-buffer (apply 'run-mode-hooks funcs)))
+ (save-current-buffer (apply #'run-mode-hooks funcs)))
;;; Various
@@ -1194,6 +1190,7 @@ ARG is passed to the first function."
;; Fixme: Why not use `with-output-to-temp-buffer'?
(defmacro gnus-with-output-to-file (file &rest body)
+ (declare (indent 1) (debug (form body)))
(let ((buffer (make-symbol "output-buffer"))
(size (make-symbol "output-buffer-size"))
(leng (make-symbol "output-buffer-length"))
@@ -1216,9 +1213,6 @@ ARG is passed to the first function."
(write-region (substring ,buffer 0 ,leng) nil ,file
,append 'no-msg))))))
-(put 'gnus-with-output-to-file 'lisp-indent-function 1)
-(put 'gnus-with-output-to-file 'edebug-form-spec '(form body))
-
(defun gnus-add-text-properties-when
(property value start end properties &optional object)
"Like `add-text-properties', only applied on where PROPERTY is VALUE."
@@ -1306,7 +1300,7 @@ sure of changing the value of `foo'."
(setq gnus-info-buffer (current-buffer))
(gnus-configure-windows 'info)))
-(defun gnus-not-ignore (&rest args)
+(defun gnus-not-ignore (&rest _)
t)
(defvar gnus-directory-sep-char-regexp "/"
@@ -1358,7 +1352,7 @@ SPEC is a predicate specifier that contains stuff like `or', `and',
`(,spec elem))
((listp spec)
(if (memq (car spec) '(or and not))
- `(,(car spec) ,@(mapcar 'gnus-make-predicate-1 (cdr spec)))
+ `(,(car spec) ,@(mapcar #'gnus-make-predicate-1 (cdr spec)))
(error "Invalid predicate specifier: %s" spec)))))
(defun gnus-completing-read (prompt collection &optional require-match
@@ -1397,6 +1391,8 @@ SPEC is a predicate specifier that contains stuff like `or', `and',
;; Make sure iswitchb is loaded before we let-bind its variables.
;; If it is loaded inside the let, variables can become unbound afterwards.
(require 'iswitchb)
+ (declare-function iswitchb-minibuffer-setup "iswitchb" ())
+ (defvar iswitchb-make-buflist-hook)
(let ((iswitchb-make-buflist-hook
(lambda ()
(setq iswitchb-temp-buflist
@@ -1410,16 +1406,14 @@ SPEC is a predicate specifier that contains stuff like `or', `and',
(unwind-protect
(progn
(or iswitchb-mode
- (add-hook 'minibuffer-setup-hook 'iswitchb-minibuffer-setup))
+ (add-hook 'minibuffer-setup-hook #'iswitchb-minibuffer-setup))
(iswitchb-read-buffer prompt def require-match))
(or iswitchb-mode
- (remove-hook 'minibuffer-setup-hook 'iswitchb-minibuffer-setup)))))
-
-(put 'gnus-parse-without-error 'lisp-indent-function 0)
-(put 'gnus-parse-without-error 'edebug-form-spec '(body))
+ (remove-hook 'minibuffer-setup-hook #'iswitchb-minibuffer-setup)))))
(defmacro gnus-parse-without-error (&rest body)
"Allow continuing onto the next line even if an error occurs."
+ (declare (indent 0) (debug (body)))
`(while (not (eobp))
(condition-case ()
(progn
@@ -1510,18 +1504,17 @@ Return nil otherwise."
(defvar tool-bar-mode)
-(defun gnus-tool-bar-update (&rest ignore)
+(defun gnus-tool-bar-update (&rest _)
"Update the tool bar."
- (when (and (boundp 'tool-bar-mode)
- tool-bar-mode)
+ (when (bound-and-true-p tool-bar-mode)
(let* ((args nil)
(func (cond ((fboundp 'tool-bar-update)
- 'tool-bar-update)
+ #'tool-bar-update)
((fboundp 'force-window-update)
- 'force-window-update)
+ #'force-window-update)
((fboundp 'redraw-frame)
(setq args (list (selected-frame)))
- 'redraw-frame)
+ #'redraw-frame)
(t 'ignore))))
(apply func args))))
@@ -1536,7 +1529,7 @@ sequence, this is like `mapcar'. With several, it is like the Common Lisp
(if seqs2_n
(let* ((seqs (cons seq1 seqs2_n))
(cnt 0)
- (heads (mapcar (lambda (seq)
+ (heads (mapcar (lambda (_seq)
(make-symbol (concat "head"
(int-to-string
(setq cnt (1+ cnt))))))
@@ -1569,8 +1562,7 @@ sequence, this is like `mapcar'. With several, it is like the Common Lisp
system-configuration)
((memq 'type lst)
(symbol-name system-type))
- (t nil)))
- codename)
+ (t nil))))
(cond
((not (memq 'emacs lst))
nil)
@@ -1586,9 +1578,7 @@ sequence, this is like `mapcar'. With several, it is like the Common Lisp
empty directories from OLD-PATH."
(when (file-exists-p old-path)
(let* ((old-dir (file-name-directory old-path))
- (old-name (file-name-nondirectory old-path))
(new-dir (file-name-directory new-path))
- (new-name (file-name-nondirectory new-path))
temp)
(gnus-make-directory new-dir)
(rename-file old-path new-path t)
@@ -1693,7 +1683,7 @@ lists of strings."
(setq props (plist-put props :foreground (face-foreground face)))
(setq props (plist-put props :background (face-background face))))
(ignore-errors
- (apply 'create-image file type data-p props))))
+ (apply #'create-image file type data-p props))))
(defun gnus-put-image (glyph &optional string category)
(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 @@
-;;; nnimap.el --- IMAP interface for Gnus
+;;; nnimap.el --- IMAP interface for Gnus -*- lexical-binding:t -*-
;; Copyright (C) 2010-2019 Free Software Foundation, Inc.