From ff88c4969617ede5742e039136159fe3650ac693 Mon Sep 17 00:00:00 2001 From: Nikolaus Rath 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 | 5 +++ lisp/gnus/nnimap.el | 93 +++++++++++++++++++++++++++++++++++++---------------- 3 files changed, 77 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 @@ fetch all textual parts, while leaving the rest on the server. 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..57b51 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -46,6 +46,11 @@ 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. + * Startup Changes in Emacs 27.1 diff --git a/lisp/gnus/nnimap.el b/lisp/gnus/nnimap.el index 3b397..efcb68 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', @@ -110,6 +117,8 @@ some servers.") (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 @@ textual parts.") (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 @@ 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)) @@ -475,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) @@ -496,8 +517,17 @@ textual parts.") (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 @@ 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) @@ -870,13 +900,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)) @@ -884,7 +914,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 @@ -944,7 +974,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 @@ -1011,7 +1041,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 @@ -1136,7 +1166,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)) @@ -1191,7 +1221,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 "^[+]")) @@ -1271,8 +1301,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 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 @@ 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 ((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 @@ 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)) @@ -1391,7 +1430,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 @@ -1413,7 +1452,7 @@ If LIMIT, first try to limit the search to the N last articles." (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 @@ 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) @@ -2105,7 +2144,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) @@ -2121,7 +2160,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