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

[Nikolaus Rath]

*ping*

It's been 80 days. Any chance someone could take a look? If I understand
correctly, the only thing that needs review are the added manual and
NEWS entries.

Best,
-Nikolaus

On Sep 17 2017, Nikolaus Rath <Nikolaus@rath.org> wrote:
> On Sep 13 2017, Lars Ingebrigtsen <larsi@gnus.org> wrote:
>> Nikolaus Rath <nikolaus@rath.org> writes:
>>
>>> Thanks for the review, revised patches attached.
>>
>> Looks good to me.  It needs to be documented in the manual, though, and
>> perhaps a NEWS entry...
>
> Updated patch is attached.
>
> 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 2c1c2ccaeb0c19649d125b64fe3f917c7a3fbb76 Mon Sep 17 00:00:00 2001
> From: Nikolaus Rath <Nikolaus@rath.org>
> 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 6e2a7..a646f4 100644
> --- a/lisp/gnus/nnimap.el
> +++ b/lisp/gnus/nnimap.el
> @@ -166,6 +166,10 @@ nnimap-quirks
>  
>  (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 @@ 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)
> @@ -867,13 +871,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))
> @@ -881,7 +885,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
> @@ -941,7 +945,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
> @@ -1008,7 +1012,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
> @@ -1133,7 +1137,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))
> @@ -1188,7 +1192,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 "^[+]"))
> @@ -1316,7 +1320,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))
> @@ -1388,7 +1392,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
> @@ -1410,7 +1414,7 @@ nnimap-retrieve-group-data-early
>               (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 @@ 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)
> @@ -2098,7 +2102,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)
> @@ -2114,7 +2118,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
>
> From f5079a11c20944027465ea21291a8fc9e7ad3be1 Mon Sep 17 00:00:00 2001
> From: Nikolaus Rath <Nikolaus@rath.org>
> 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.
> ---
>  doc/misc/gnus.texi  |  6 +++++
>  etc/NEWS            |  5 ++++
>  lisp/gnus/nnimap.el | 66 
> ++++++++++++++++++++++++++++++++++++++++++-----------
>  3 files changed, 64 insertions(+), 13 deletions(-)
>
> diff --git a/doc/misc/gnus.texi b/doc/misc/gnus.texi
> index 88e121..4b33e 100644
> --- a/doc/misc/gnus.texi
> +++ b/doc/misc/gnus.texi
> @@ -14301,6 +14301,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 371cd..1f905d 100644
> --- a/etc/NEWS
> +++ b/etc/NEWS
> @@ -37,6 +37,11 @@ When you add a new item, use the appropriate mark if you 
> are sure it applies,
>
>  * Changes in Specialized Modes and Packages in Emacs 27.1
>  
> +** Gnus
> +
> ++++
> +*** The nnimap backend now has support for IMAP namespaces.
> +
>
>  * New Modes and Packages in Emacs 27.1
>  
> diff --git a/lisp/gnus/nnimap.el b/lisp/gnus/nnimap.el
> index a646f4..7ad54a 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 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 @@ nnimap-decode-gnus-group
>  (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 @@ nnimap-inhibit-logging
>  
>  (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 @@ 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))
>  
> @@ -478,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)
> @@ -499,7 +517,21 @@ 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))))))
> +                             (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 @@ nnimap-add-cr
>  
>  (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 @@ 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 ((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
>


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

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