Subject: [PATCH] Keep IMAP connection opened with nnml

From: Manuel Giraud <[email-masked]>
Date: Thu, 06 Mar 2025 17:11:41 +0100

Tags: patch

Hi,

Here is a patch that permits a Gnus/nnml user to define the name of the
buffer for IMAP communication.  Like this, for instance:

(setq mail-sources '((imap :server "example.com"
                           :stream tls
			   :buffer " *imap example.com*")))
                           
Doing so, said buffer will be kept connected for the entire Gnus
session.  FWIW, I'm using it right now and it seems like a quite
effective way to speed up mail retrieving (even better with multiple
IMAP servers).

I have no use for this myself but I guess that this feature could also
be extended to POP servers.

In GNU Emacs 31.0.50 (build 22, x86_64-unknown-openbsd7.6, X toolkit) of
 2025-03-06 built on computer
Repository revision: fe7a8c92be6269f8fc7933eb6c190178839d0f8a
Repository branch: mgi/mail-source-keep-connect
Windowing system distributor 'The X.Org Foundation', version 11.0.12101015
System Description: OpenBSD computer 7.6 GENERIC.MP#567 amd64

Configured using:
 'configure CC=egcc CPPFLAGS=-I/usr/local/include
 LDFLAGS=-L/usr/local/lib MAKEINFO=gmakeinfo --prefix=/home/manuel/emacs
 --bindir=/home/manuel/bin --with-x-toolkit=lucid
 --with-toolkit-scroll-bars=no --without-cairo
 --without-compress-install'

>From 75f85630179d09ccc058c6771415c6bff59f618c Mon Sep 17 00:00:00 2001
From: Manuel Giraud <[email-masked]>
Date: Thu, 6 Mar 2025 15:40:48 +0100
Subject: [PATCH] Keep IMAP connection opened with nnml

* lisp/gnus/mail-source.el (mail-source-fetch-imap): Keep
connection opened when user provide a buffer name.
* lisp/gnus/nnml.el (nnml-connected-buffer-list): New variable
of connected buffers.
(nnml-request-close): New function that closes connected buffers
when quitting Gnus.
* doc/misc/gnus.texi (Mail Source Specifiers): Document the
feature.
---
 doc/misc/gnus.texi       |  8 ++++++++
 lisp/gnus/mail-source.el | 28 ++++++++++++++++++++--------
 lisp/gnus/nnml.el        | 12 ++++++++++++
 3 files changed, 40 insertions(+), 8 deletions(-)

diff --git a/doc/misc/gnus.texi b/doc/misc/gnus.texi
index a239a8a628b..9a003d0c3a6 100644
--- a/doc/misc/gnus.texi
+++ b/doc/misc/gnus.texi
@@ -15408,6 +15408,14 @@ Mail Source Specifiers
 If non-@code{nil}, don't remove all articles marked as deleted in the
 mailbox after finishing the fetch.
 
+@item :buffer
+The name of the buffer used to communicate with the @acronym{IMAP}
+server.  By default, Gnus creates such a buffer on the fly and kills it
+after having retrieved some mails.  By setting this option, the
+connection with the server is kept open for the entire Gnus session.
+Preferably, you would use a buffer name starting with the space
+character to avoid it being list in @code{list-buffers} for instance.
+
 @end table
 
 An example @acronym{IMAP} mail source:
diff --git a/lisp/gnus/mail-source.el b/lisp/gnus/mail-source.el
index 954dce92e84..f4685af0f72 100644
--- a/lisp/gnus/mail-source.el
+++ b/lisp/gnus/mail-source.el
@@ -349,6 +349,7 @@ mail-source-new-mail-available
        (:mailbox "INBOX")
        (:predicate "UNSEEN UNDELETED")
        (:fetchflag "\\Deleted")
+       (:buffer)
        (:prescript)
        (:prescript-delay)
        (:postscript)
@@ -1034,6 +1035,7 @@ mail-source-fetch-maildir
       found)))
 
 (autoload 'imap-open "imap")
+(autoload 'imap-opened "imap")
 (autoload 'imap-authenticate "imap")
 (autoload 'imap-mailbox-select "imap")
 (autoload 'imap-mailbox-unselect "imap")
@@ -1046,6 +1048,7 @@ mail-source-fetch-maildir
 (autoload 'imap-list-to-message-set "imap")
 (autoload 'imap-range-to-message-set "imap")
 (autoload 'nnheader-ms-strip-cr "nnheader")
+(autoload 'nnml-connected-buffer-list "nnml")
 
 (defvar mail-source-imap-file-coding-system 'binary
   "Coding system for the crashbox made by `mail-source-fetch-imap'.")
@@ -1063,14 +1066,21 @@ mail-source-fetch-imap
      prescript-delay)
     (let ((from (format "%s:%s:%s" server user port))
 	  (found 0)
-	  (buf (generate-new-buffer " *imap source*"))
+	  (buf (if buffer
+                   (get-buffer-create buffer)
+                 (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))
+      (if (or (and buffer (imap-opened buf))
+              (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))))
+            ;; Remember communication buffer if needed.
+            (when (and buffer
+                       (not (member buf nnml-connected-buffer-list)))
+              (push buf nnml-connected-buffer-list))
             (dolist (mailbox mailbox-list)
               (when (imap-mailbox-select mailbox nil buf)
 	        (let ((coding-system-for-write
@@ -1114,7 +1124,9 @@ mail-source-fetch-imap
 	    (if dontexpunge
 		(imap-mailbox-unselect buf)
               (imap-mailbox-close nil buf)))))
-            (imap-close buf))
+            ;; If the user has provided a buffer name keep the
+            ;; connection opened.
+            (unless buffer (imap-close buf)))
 	(imap-close buf)
 	;; We nix out the password in case the error
 	;; was because of a wrong password being given.
@@ -1122,7 +1134,7 @@ mail-source-fetch-imap
 	      (delq (assoc from mail-source-password-cache)
 		    mail-source-password-cache))
 	(error "IMAP error: %s" (imap-error-text buf)))
-      (kill-buffer buf)
+      (unless buffer (kill-buffer buf))
       (mail-source-run-script
        postscript
        `((?p . ,password) (?t . ,mail-source-crash-box)
diff --git a/lisp/gnus/nnml.el b/lisp/gnus/nnml.el
index 4366391a66d..0e4546cd7bb 100644
--- a/lisp/gnus/nnml.el
+++ b/lisp/gnus/nnml.el
@@ -541,6 +541,18 @@ nnml-set-status
 	(nnmail-replace-status name value))
       t))))
 
+;;;###autoload
+(defvar nnml-connected-buffer-list nil)
+
+(deffoo nnml-request-close ()
+  (let (buf)
+    (while (setq buf (pop nnml-connected-buffer-list))
+      (when (buffer-live-p buf)
+        (with-current-buffer buf
+	  (when (imap-opened)
+	    (imap-close)))
+        (kill-buffer buf)))))
+
 
 ;;; Internal functions.
 
-- 
2.48.1

-- 
Manuel Giraud