bug-gnu-emacs
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

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


From: Nikolaus Rath
Subject: bug#21057: [PATCH] nnimap.el: add support for IMAP namespaces
Date: Tue, 05 Sep 2017 17:26:23 +0200
User-agent: Gnus/5.130014 (Ma Gnus v0.14) Emacs/25.1 (gnu/linux)

Hi,

Attached is the updated patch. Should apply cleanly on Emacs master.

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

             »Time flies like an arrow, fruit flies like a Banana.«
>From b21e4eb2e788e83cb5d82b9eac7f7e3ecd0de837 Mon Sep 17 00:00:00 2001
From: Nikolaus Rath <address@hidden>
Date: Sun, 12 Jul 2015 11:10:28 -0700
Subject: [PATCH 1/2] nnimap.el: factor out nnimap-group-to-imap

* 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.
---
 lisp/gnus/nnimap.el | 32 ++++++++++++++++++--------------
 1 file changed, 18 insertions(+), 14 deletions(-)

diff --git a/lisp/gnus/nnimap.el b/lisp/gnus/nnimap.el
index 2943c..17542 100644
--- a/lisp/gnus/nnimap.el
+++ b/lisp/gnus/nnimap.el
@@ -166,6 +166,10 @@ textual parts.")
 
 (defvar nnimap-inhibit-logging nil)
 
+(defun nnimap-group-to-imap (group)
+  "Convert Gnus group name to IMAP mailbox name"
+  (utf7-encode group t))
+
 (defun nnimap-buffer ()
   (nnimap-find-process-buffer nntp-server-buffer))
 
@@ -834,7 +838,7 @@ textual parts.")
       (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)
@@ -867,13 +871,13 @@ textual parts.")
   (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))
@@ -881,7 +885,7 @@ textual parts.")
     (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
@@ -941,7 +945,7 @@ textual parts.")
                                "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
@@ -1008,7 +1012,7 @@ textual parts.")
                     "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
@@ -1133,7 +1137,7 @@ If LIMIT, first try to limit the search to the N last 
articles."
                      (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))
@@ -1188,7 +1192,7 @@ If LIMIT, first try to limit the search to the N last 
articles."
            (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 "^[+]"))
@@ -1316,7 +1320,7 @@ If LIMIT, first try to limit the search to the N last 
articles."
            (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))
@@ -1388,7 +1392,7 @@ If LIMIT, first try to limit the search to the N last 
articles."
                   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
@@ -1410,7 +1414,7 @@ If LIMIT, first try to limit the search to the N last 
articles."
                (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))))
@@ -1842,7 +1846,7 @@ Return the server's response to the SELECT or EXAMINE 
command."
                                       (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)
@@ -2098,7 +2102,7 @@ Return the server's response to the SELECT or EXAMINE 
command."
            (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)
@@ -2114,7 +2118,7 @@ Return the server's response to the SELECT or EXAMINE 
command."
                                     "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

>From a1a268af15472905d7fa81347f0d65abc5702b86 Mon Sep 17 00:00:00 2001
From: Nikolaus Rath <address@hidden>
Date: Tue, 14 Jul 2015 19:03:09 -0700
Subject: [PATCH 2/2] nnimap.el: Add support for IMAP namespaces.

* lisp/gnus/nnimap.el (nnimap-use-namespaces): introduced 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 | 66 ++++++++++++++++++++++++++++++++++++++++++-----------
 1 file changed, 53 insertions(+), 13 deletions(-)

diff --git a/lisp/gnus/nnimap.el b/lisp/gnus/nnimap.el
index 17542..fb382 100644
--- a/lisp/gnus/nnimap.el
+++ b/lisp/gnus/nnimap.el
@@ -55,6 +55,13 @@
 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 cosmetical, 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',
@@ -116,6 +123,8 @@ some servers.")
 (defun nnimap-encode-gnus-group (group)
   (encode-coding-string group 'utf-8))
 
+(setq nnimap-namespaces nil)
+
 (defvoo nnimap-fetch-partial-articles nil
   "If non-nil, Gnus will fetch partial articles.
 If t, Gnus will fetch only the first part.  If a string, it
@@ -168,7 +177,17 @@ textual parts.")
 
 (defun nnimap-group-to-imap (group)
   "Convert Gnus group name to IMAP mailbox name"
-  (utf7-encode group t))
+  (let* ((prefix (cadr (assoc (nnoo-current-server 'nnimap)
+                              nnimap-namespaces)))
+         (inbox (substring prefix 0 -1)))
+    (utf7-encode
+     (cond ((or (not prefix)
+                (string-equal group inbox))
+            group)
+           ((string-prefix-p "#" group)
+            (substring group 1))
+           (t
+            (concat prefix group))) t)))
 
 (defun nnimap-buffer ()
   (nnimap-find-process-buffer nntp-server-buffer))
@@ -445,7 +464,8 @@ textual parts.")
             (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))
 
@@ -478,9 +498,7 @@ textual parts.")
                                ;; 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)
@@ -499,7 +517,21 @@ textual parts.")
                      (dolist (response (cddr (nnimap-command "CAPABILITY")))
                        (when (string= "CAPABILITY" (upcase (car response)))
                          (setf (nnimap-capabilities nnimap-object)
-                               (mapcar #'upcase (cdr response))))))
+                               (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)
+                            (let ((namespace (cons (match-string 1 response)
+                                                   (match-string 2 response)))
+                                  (entry (assoc server nnimap-namespaces)))
+                              (if entry
+                                  (setcdr entry namespace)
+                                (push (cons server namespace) 
nnimap-namespaces)))))))
                  ;; If the login failed, then forget the credentials
                  ;; that are now possibly cached.
                  (dolist (host (list (nnoo-current-server 'nnimap)
@@ -1272,8 +1304,12 @@ If LIMIT, first try to limit the search to the N last 
articles."
 
 (defun nnimap-get-groups ()
   (erase-buffer)
-  (let ((sequence (nnimap-send-command "LIST \"\" \"*\""))
-       groups)
+  (let* ((sequence (nnimap-send-command "LIST \"\" \"*\""))
+         (prefix (cadr (assoc (nnoo-current-server 'nnimap)
+                              nnimap-namespaces)))
+         (prefix-len (length prefix))
+         (inbox (substring prefix 0 -1))
+         groups)
     (nnimap-wait-for-response sequence)
     (subst-char-in-region (point-min) (point-max)
                          ?\\ ?% t)
@@ -1290,11 +1326,15 @@ If LIMIT, first try to limit the search to the N last 
articles."
                           (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 ((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)
-- 
2.11.0


reply via email to

[Prev in Thread] Current Thread [Next in Thread]