* [PATCH] Keep IMAP connection open when used in mail-sources
@ 2023-12-17 21:58 Adam Sjøgren
0 siblings, 0 replies; only message in thread
From: Adam Sjøgren @ 2023-12-17 21:58 UTC (permalink / raw)
To: ding
* lisp/gnus/mail-source.el (mail-source-fetch-imap): don't close
process buffer and only open if it isn't already. Name it per
user, server, port.
---
Hi,
If you are using IMAP as POP, ie you have imap entries in your
mail-sources, this patch is for you.
Back in January I got annoyed by Gnus closing down the IMAP-connection
after every 'g', and opening it on the next (I may be using 'g' a
little too much), so I made this change to keep the process buffer
open and around after fetching mail - and I have been using it ever
since.
I only have one IMAP entry in my mail-sources, so while this change
has been working well for almost a year, the testing has admittedly
been one-sided.
I hope you find it useful!
Best regards,
Adam
lisp/gnus/mail-source.el | 137 ++++++++++++++++++++-------------------
1 file changed, 72 insertions(+), 65 deletions(-)
diff --git a/lisp/gnus/mail-source.el b/lisp/gnus/mail-source.el
index f870c0b8274..d3e58943f9c 100644
--- a/lisp/gnus/mail-source.el
+++ b/lisp/gnus/mail-source.el
@@ -1063,71 +1063,78 @@ mail-source-fetch-imap
prescript-delay)
(let ((from (format "%s:%s:%s" server user port))
(found 0)
- (buf (generate-new-buffer " *imap source*"))
- (imap-shell-program (or (list program) imap-shell-program)))
- (if (and (imap-open server port stream authentication buf)
- (imap-authenticate
- user (or (cdr (assoc from mail-source-password-cache))
- password)
- buf))
- (let ((mailbox-list (if (listp mailbox) mailbox (list mailbox))))
- (dolist (mailbox mailbox-list)
- (when (imap-mailbox-select mailbox nil buf)
- (let ((coding-system-for-write
- mail-source-imap-file-coding-system)
- (mail-source-string (format "imap:%s:%s" server mailbox))
- str remove)
- (message "Fetching from %s..." mailbox)
- (with-temp-file mail-source-crash-box
- ;; Avoid converting 8-bit chars from inserted strings to
- ;; multibyte.
- (mm-disable-multibyte)
- ;; remember password
- (with-current-buffer buf
- (when (and imap-password
- (not (member (cons from imap-password)
- mail-source-password-cache)))
- (push (cons from imap-password) mail-source-password-cache)))
- ;; if predicate is nil, use all uids
- (dolist (uid (imap-search (or predicate "1:*") buf))
- (when (setq str
- (if (imap-capability 'IMAP4rev1 buf)
- (caddar (imap-fetch uid "BODY.PEEK[]"
- 'BODYDETAIL nil buf))
- (imap-fetch uid "RFC822.PEEK" 'RFC822 nil buf)))
- (push uid remove)
- (insert "From imap " (current-time-string) "\n")
- (save-excursion
- (insert str "\n\n"))
- (while (let ((case-fold-search nil))
- (re-search-forward "^From " nil t))
- (replace-match ">From "))
- (goto-char (point-max))))
- (nnheader-ms-strip-cr))
- (cl-incf found (mail-source-callback callback server))
- (mail-source-delete-crash-box)
- (when (and remove fetchflag)
- (setq remove (nreverse remove))
- (imap-message-flags-add
- (imap-range-to-message-set (gnus-compress-sequence remove))
- fetchflag nil buf))
- (if dontexpunge
- (imap-mailbox-unselect buf)
- (imap-mailbox-close nil buf)))))
- (imap-close buf))
- (imap-close buf)
- ;; We nix out the password in case the error
- ;; was because of a wrong password being given.
- (setq mail-source-password-cache
- (delq (assoc from mail-source-password-cache)
- mail-source-password-cache))
- (error "IMAP error: %s" (imap-error-text buf)))
- (kill-buffer buf)
- (mail-source-run-script
- postscript
- `((?p . ,password) (?t . ,mail-source-crash-box)
- (?s . ,server) (?P . ,port) (?u . ,user)))
- found)))
+ (buffer-name (format " *imap source %s@%s:%s" user server (or port "default")))
+ (imap-shell-program (or (list program) imap-shell-program)))
+ (let ((buf (or (and (or (get-buffer-process buffer-name)
+ (and (get-buffer buffer-name)
+ (kill-buffer buffer-name)))
+ (get-buffer buffer-name))
+ (let ((newbuf (generate-new-buffer buffer-name)))
+ (if (and (imap-open server port stream authentication newbuf)
+ (imap-authenticate
+ user (or (cdr (assoc from mail-source-password-cache))
+ password)
+ newbuf))
+ (progn
+ (set-process-query-on-exit-flag (get-buffer-process newbuf) nil)
+ newbuf)
+ (progn
+ (imap-close newbuf)
+ ;; We nix out the password in case the error
+ ;; was because of a wrong password being given.
+ (setq mail-source-password-cache
+ (delq (assoc from mail-source-password-cache)
+ mail-source-password-cache))
+ (error "IMAP error: %s" (imap-error-text newbuf))))))))
+ (let ((mailbox-list (if (listp mailbox) mailbox (list mailbox))))
+ (dolist (mailbox mailbox-list)
+ (when (imap-mailbox-select mailbox nil buf)
+ (let ((coding-system-for-write
+ mail-source-imap-file-coding-system)
+ (mail-source-string (format "imap:%s:%s" server mailbox))
+ str remove)
+ (message "Fetching from %s..." mailbox)
+ (with-temp-file mail-source-crash-box
+ ;; Avoid converting 8-bit chars from inserted strings to
+ ;; multibyte.
+ (mm-disable-multibyte)
+ ;; remember password
+ (with-current-buffer buf
+ (when (and imap-password
+ (not (member (cons from imap-password)
+ mail-source-password-cache)))
+ (push (cons from imap-password) mail-source-password-cache)))
+ ;; if predicate is nil, use all uids
+ (dolist (uid (imap-search (or predicate "1:*") buf))
+ (when (setq str
+ (if (imap-capability 'IMAP4rev1 buf)
+ (caddar (imap-fetch uid "BODY.PEEK[]"
+ 'BODYDETAIL nil buf))
+ (imap-fetch uid "RFC822.PEEK" 'RFC822 nil buf)))
+ (push uid remove)
+ (insert "From imap " (current-time-string) "\n")
+ (save-excursion
+ (insert str "\n\n"))
+ (while (let ((case-fold-search nil))
+ (re-search-forward "^From " nil t))
+ (replace-match ">From "))
+ (goto-char (point-max))))
+ (nnheader-ms-strip-cr))
+ (cl-incf found (mail-source-callback callback server))
+ (mail-source-delete-crash-box)
+ (when (and remove fetchflag)
+ (setq remove (nreverse remove))
+ (imap-message-flags-add
+ (imap-range-to-message-set (gnus-compress-sequence remove))
+ fetchflag nil buf))
+ (if dontexpunge
+ (imap-mailbox-unselect buf)
+ (imap-mailbox-close nil buf))))))
+ (mail-source-run-script
+ postscript
+ `((?p . ,password) (?t . ,mail-source-crash-box)
+ (?s . ,server) (?P . ,port) (?u . ,user)))
+ found))))
(provide 'mail-source)
--
2.40.1
^ permalink raw reply [flat|nested] only message in thread
only message in thread, other threads:[~2023-12-18 17:02 UTC | newest]
Thread overview: (only message) (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2023-12-17 21:58 [PATCH] Keep IMAP connection open when used in mail-sources Adam Sjøgren
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for NNTP newsgroup(s).