bug#21057: [PATCH] nnimap.el: add support for IMAP namespaces

[Nikolaus Rath <Nikolaus@rath.org>]

[-- Attachment #1: Type: text/plain, Size: 250 bytes --]

On Jul 23 2018, Robert Pluim <rpluim@gmail.com> wrote:
> Nikolaus Rath <Nikolaus@rath.org> writes:
>
> Nitpicks below.

Fixed, updated patch attached.

> Does this also work for secondary servers? I imagine it does.

Yes, it should.

Best,
-Nikolaus

[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-Make-nnimap-support-IMAP-namespaces.patch --]
[-- Type: text/x-diff, Size: 12568 bytes --]

From 90b4930ec9004caaa39615edb1bd271bc14aeecb Mon Sep 17 00:00:00 2001
From: Nikolaus Rath <Nikolaus@rath.org>
Date: Mon, 23 Jul 2018 10:21:46 +0100
Subject: [PATCH] Make nnimap support IMAP namespaces

* lisp/gnus/nnimap.el (nnimap-use-namespaces): Introduce new
server variable.
(nnimap-group-to-imap, nnimap-get-groups): Transform IMAP group
names to Gnus group name by stripping / prefixing personal
namespace prefix.
(nnimap-open-connection-1): Ask server for namespaces and store them.

* lisp/gnus/nnimap.el (nnimap-request-group-scan)
(nnimap-request-create-group, nnimap-request-delete-group)
(nnimap-request-rename-group, nnimap-request-move-article)
(nnimap-process-expiry-targets)
(nnimap-request-update-group-status)
(nnimap-request-accept-article, nnimap-request-list)
(nnimap-retrieve-group-data-early, nnimap-change-group)
(nnimap-split-incoming-mail): Use nnimap-group-to-imap.
(nnimap-group-to-imap): New function to map Gnus group names to
IMAP folder names.
---
 doc/misc/gnus.texi  |  6 ++++
 etc/NEWS            |  7 ++++
 lisp/gnus/nnimap.el | 93 +++++++++++++++++++++++++++++++++++++----------------
 3 files changed, 79 insertions(+), 27 deletions(-)

diff --git a/doc/misc/gnus.texi b/doc/misc/gnus.texi
index 6793ed..cd97cf 100644
--- a/doc/misc/gnus.texi
+++ b/doc/misc/gnus.texi
@@ -14320,6 +14320,12 @@ Customizing the IMAP Connection
 If non-@code{nil}, record all @acronym{IMAP} commands in the
 @samp{"*imap log*"} buffer.
 
+@item nnimap-use-namespaces
+If non-@code{nil}, omit the IMAP namespace prefix in nnimap group
+names. If your IMAP mailboxes are called something like @samp{INBOX}
+and @samp{INBOX.Lists.emacs}, but you'd like the nnimap group names to
+be @samp{INBOX} and @samp{Lists.emacs}, you should enable this option.
+
 @end table
 
 
diff --git a/etc/NEWS b/etc/NEWS
index fc2a5..04b4a 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -46,6 +46,13 @@ option --enable-check-lisp-object-type is therefore no longer as
 useful and so is no longer enabled by default in developer builds,
 to reduce differences between developer and production builds.
 
+** Gnus
+
++++
+*** The nnimap backend now has support for IMAP namespaces.
+This feature can be enabled by setting the new 'nnimap-use-namespaces'
+server variable to non-nil.
+
 \f
 * Startup Changes in Emacs 27.1
 
diff --git a/lisp/gnus/nnimap.el b/lisp/gnus/nnimap.el
index 3b397..1736f8 100644
--- a/lisp/gnus/nnimap.el
+++ b/lisp/gnus/nnimap.el
@@ -55,6 +55,13 @@ nnimap-server-port
 If nnimap-stream is `ssl', this will default to `imaps'.  If not,
 it will default to `imap'.")
 
+(defvoo nnimap-use-namespaces nil
+  "Whether to use IMAP namespaces.
+If in Gnus your folder names in all start with (e.g.) `INBOX',
+you probably want to set this to t. The effects of this are
+purely cosmetic, but changing this variable will affect the
+names of your nnimap groups. ")
+
 (defvoo nnimap-stream 'undecided
   "How nnimap talks to the IMAP server.
 The value should be either `undecided', `ssl' or `tls',
@@ -110,6 +117,8 @@ nnimap-connection-alist
 
 (defvoo nnimap-current-infos nil)
 
+(defvoo nnimap-namespace nil)
+
 (defun nnimap-decode-gnus-group (group)
   (decode-coding-string group 'utf-8))
 
@@ -166,6 +175,19 @@ nnimap-quirks
 
 (defvar nnimap-inhibit-logging nil)
 
+(defun nnimap-group-to-imap (group)
+  "Convert Gnus group name to IMAP mailbox name."
+  (let* ((inbox (if nnimap-namespace
+                    (substring nnimap-namespace 0 -1) nil)))
+    (utf7-encode
+     (cond ((or (not inbox)
+                (string-equal group inbox))
+            group)
+           ((string-prefix-p "#" group)
+            (substring group 1))
+           (t
+            (concat nnimap-namespace group))) t)))
+
 (defun nnimap-buffer ()
   (nnimap-find-process-buffer nntp-server-buffer))
 
@@ -442,7 +464,8 @@ nnimap-open-connection-1
 	     (props (cdr stream-list))
 	     (greeting (plist-get props :greeting))
 	     (capabilities (plist-get props :capabilities))
-	     (stream-type (plist-get props :type)))
+	     (stream-type (plist-get props :type))
+             (server (nnoo-current-server 'nnimap)))
 	(when (and stream (not (memq (process-status stream) '(open run))))
 	  (setq stream nil))
 
@@ -475,9 +498,7 @@ nnimap-open-connection-1
                                ;; the virtual server name and the address
                                (nnimap-credentials
 				(gnus-delete-duplicates
-				 (list
-                                  (nnoo-current-server 'nnimap)
-				  nnimap-address))
+				 (list server nnimap-address))
                                 ports
                                 nnimap-user))))
 		  (setq nnimap-object nil)
@@ -496,8 +517,17 @@ nnimap-open-connection-1
 		      (dolist (response (cddr (nnimap-command "CAPABILITY")))
 			(when (string= "CAPABILITY" (upcase (car response)))
 			  (setf (nnimap-capabilities nnimap-object)
-				(mapcar #'upcase (cdr response))))))
-		  ;; If the login failed, then forget the credentials
+				(mapcar #'upcase (cdr response)))))
+                      (when (and nnimap-use-namespaces
+                                 (nnimap-capability "NAMESPACE"))
+                        (erase-buffer)
+                        (nnimap-wait-for-response (nnimap-send-command "NAMESPACE"))
+                        (let ((response (nnimap-last-response-string)))
+                          (when (string-match
+                                 "^\\*\\W+NAMESPACE\\W+((\"\\([^\"\n]+\\)\"\\W+\"\\(.\\)\"))\\W+"
+                                 response)
+                            (setq nnimap-namespace (match-string 1 response))))))
+                  ;; If the login failed, then forget the credentials
 		  ;; that are now possibly cached.
 		  (dolist (host (list (nnoo-current-server 'nnimap)
 				      nnimap-address))
@@ -837,7 +867,7 @@ nnimap-request-group-scan
       (with-current-buffer (nnimap-buffer)
 	(erase-buffer)
 	(let ((group-sequence
-	       (nnimap-send-command "SELECT %S" (utf7-encode group t)))
+	       (nnimap-send-command "SELECT %S" (nnimap-group-to-imap group)))
 	      (flag-sequence
 	       (nnimap-send-command "UID FETCH 1:* FLAGS")))
 	  (setf (nnimap-group nnimap-object) group)
@@ -870,13 +900,13 @@ nnimap-request-create-group
   (setq group (nnimap-decode-gnus-group group))
   (when (nnimap-change-group nil server)
     (with-current-buffer (nnimap-buffer)
-      (car (nnimap-command "CREATE %S" (utf7-encode group t))))))
+      (car (nnimap-command "CREATE %S" (nnimap-group-to-imap group))))))
 
 (deffoo nnimap-request-delete-group (group &optional _force server)
   (setq group (nnimap-decode-gnus-group group))
   (when (nnimap-change-group nil server)
     (with-current-buffer (nnimap-buffer)
-      (car (nnimap-command "DELETE %S" (utf7-encode group t))))))
+      (car (nnimap-command "DELETE %S" (nnimap-group-to-imap group))))))
 
 (deffoo nnimap-request-rename-group (group new-name &optional server)
   (setq group (nnimap-decode-gnus-group group))
@@ -884,7 +914,7 @@ nnimap-request-rename-group
     (with-current-buffer (nnimap-buffer)
       (nnimap-unselect-group)
       (car (nnimap-command "RENAME %S %S"
-			   (utf7-encode group t) (utf7-encode new-name t))))))
+			   (nnimap-group-to-imap group) (nnimap-group-to-imap new-name))))))
 
 (defun nnimap-unselect-group ()
   ;; Make sure we don't have this group open read/write by asking
@@ -944,7 +974,7 @@ nnimap-request-move-article
 				"UID COPY %d %S"))
 		     (result (nnimap-command
 			      command article
-			      (utf7-encode internal-move-group t))))
+                              (nnimap-group-to-imap internal-move-group))))
                 (when (and (car result) (not can-move))
                   (nnimap-delete-article article))
                 (cons internal-move-group
@@ -1011,7 +1041,7 @@ nnimap-process-expiry-targets
                     "UID MOVE %s %S"
                   "UID COPY %s %S")
                 (nnimap-article-ranges (gnus-compress-sequence articles))
-                (utf7-encode (gnus-group-real-name nnmail-expiry-target) t))
+                (nnimap-group-to-imap (gnus-group-real-name nnmail-expiry-target)))
                (set (if can-move 'deleted-articles 'articles-to-delete) articles))))
       t)
      (t
@@ -1136,7 +1166,7 @@ nnimap-request-update-group-status
 		      (unsubscribe "UNSUBSCRIBE")))))
       (when command
 	(with-current-buffer (nnimap-buffer)
-	  (nnimap-command "%s %S" (cadr command) (utf7-encode group t)))))))
+	  (nnimap-command "%s %S" (cadr command) (nnimap-group-to-imap group)))))))
 
 (deffoo nnimap-request-set-mark (group actions &optional server)
   (setq group (nnimap-decode-gnus-group group))
@@ -1191,7 +1221,7 @@ nnimap-request-accept-article
 	    (nnimap-unselect-group))
 	  (erase-buffer)
 	  (setq sequence (nnimap-send-command
-			  "APPEND %S {%d}" (utf7-encode group t)
+			  "APPEND %S {%d}" (nnimap-group-to-imap group)
 			  (length message)))
 	  (unless nnimap-streaming
 	    (nnimap-wait-for-connection "^[+]"))
@@ -1271,8 +1301,12 @@ nnimap-add-cr
 
 (defun nnimap-get-groups ()
   (erase-buffer)
-  (let ((sequence (nnimap-send-command "LIST \"\" \"*\""))
-	groups)
+  (let* ((sequence (nnimap-send-command "LIST \"\" \"*\""))
+         (prefix nnimap-namespace)
+         (prefix-len (if prefix (length prefix) nil))
+         (inbox (if prefix
+                    (substring prefix 0 -1) nil))
+         groups)
     (nnimap-wait-for-response sequence)
     (subst-char-in-region (point-min) (point-max)
 			  ?\\ ?% t)
@@ -1289,11 +1323,16 @@ nnimap-get-groups
 			   (skip-chars-backward " \r\"")
 			   (point)))))
 	(unless (member '%NoSelect flags)
-	  (push (utf7-decode (if (stringp group)
-				 group
-			       (format "%s" group))
-                             t)
-		groups))))
+          (let* ((group (utf7-decode (if (stringp group) group
+                                       (format "%s" group)) t))
+                 (group (cond ((or (not prefix)
+                                   (equal inbox group))
+                               group)
+                              ((string-prefix-p prefix group)
+                               (substring group prefix-len))
+                              (t
+                               (concat "#" group)))))
+            (push group groups)))))
     (nreverse groups)))
 
 (defun nnimap-get-responses (sequences)
@@ -1319,7 +1358,7 @@ nnimap-request-list
 	    (dolist (group groups)
 	      (setf (nnimap-examined nnimap-object) group)
 	      (push (list (nnimap-send-command "EXAMINE %S"
-					       (utf7-encode group t))
+					       (nnimap-group-to-imap group))
 			  group)
 		    sequences))
 	    (nnimap-wait-for-response (caar sequences))
@@ -1391,7 +1430,7 @@ nnimap-retrieve-group-data-early
 		   unexist)
 	      (push
 	       (list (nnimap-send-command "EXAMINE %S (%s (%s %s))"
-					  (utf7-encode group t)
+					  (nnimap-group-to-imap group)
 					  (nnimap-quirk "QRESYNC")
 					  uidvalidity modseq)
 		     'qresync
@@ -1413,7 +1452,7 @@ nnimap-retrieve-group-data-early
 		(cl-incf (nnimap-initial-resync nnimap-object))
 		(setq start 1))
 	      (push (list (nnimap-send-command "%s %S" command
-					       (utf7-encode group t))
+					       (nnimap-group-to-imap group))
 			  (nnimap-send-command "UID FETCH %d:* FLAGS" start)
 			  start group command)
 		    sequences))))
@@ -1847,7 +1886,7 @@ nnimap-change-group
                                       (if read-only
                                           "EXAMINE"
                                         "SELECT")
-                                      (utf7-encode group t))))
+                                      (nnimap-group-to-imap group))))
           (when (car result)
             (setf (nnimap-group nnimap-object) group
                   (nnimap-select-result nnimap-object) result)
@@ -2105,7 +2144,7 @@ nnimap-split-incoming-mail
 	    (dolist (spec specs)
 	      (when (and (not (member (car spec) groups))
 			 (not (eq (car spec) 'junk)))
-		(nnimap-command "CREATE %S" (utf7-encode (car spec) t))))
+		(nnimap-command "CREATE %S" (nnimap-group-to-imap (car spec)))))
 	    ;; Then copy over all the messages.
 	    (erase-buffer)
 	    (dolist (spec specs)
@@ -2121,7 +2160,7 @@ nnimap-split-incoming-mail
 				     "UID MOVE %s %S"
 				   "UID COPY %s %S")
 				 (nnimap-article-ranges ranges)
-				 (utf7-encode group t))
+				(nnimap-group-to-imap group))
 				ranges)
 			  sequences)))))
 	    ;; Wait for the last COPY response...
-- 
2.11.0


[-- Attachment #3: Type: text/plain, Size: 150 bytes --]



-- 
GPG Fingerprint: ED31 791B 2C5C 1613 AF38 8B8A D113 FCAC 3C4E 599F

             »Time flies like an arrow, fruit flies like a Banana.«