Github/emacs
2
0
Fork 1
mirror of git://git.sv.gnu.org/emacs.git synced 2026-02-16 17:24:23 +00:00
Code Issues Projects Releases Packages Wiki Activity

Make nnimap support IMAP namespaces

Browse source 
* 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.  (Bug#21057)
This commit is contained in:
Nikolaus Rath 2018-07-23 10:21:46 +01:00 committed by Eli Zaretskii
parent 3f8324e0de
commit 31263d67d5
3 changed files with 79 additions and 27 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

6
doc/misc/gnus.texi
View file

@ -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

7
etc/NEWS
View file

@ -53,6 +53,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.
* Startup Changes in Emacs 27.1

93
lisp/gnus/nnimap.el
View file

@ -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 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 @@ 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...