diff options
author | Trevor Murphy <trevor.m.murphy@gmail.com> | 2015-01-26 07:56:37 +0000 |
---|---|---|
committer | Katsumi Yamaoka <yamaoka@jpl.org> | 2015-01-26 07:56:37 +0000 |
commit | 242354a23acf214ad06d4e3e7e5f5580c8b21d4a (patch) | |
tree | 8a939498d116cc31c771a397a296d12fba843cf9 /lisp/gnus/nnimap.el | |
parent | dafb0ef852f88f535df5527def7516a13bf63c60 (diff) | |
download | emacs-242354a23acf214ad06d4e3e7e5f5580c8b21d4a.tar.gz emacs-242354a23acf214ad06d4e3e7e5f5580c8b21d4a.tar.bz2 emacs-242354a23acf214ad06d4e3e7e5f5580c8b21d4a.zip |
lisp/gnus/nnimap.el Allow using the Google X-GM-LABELS, if present
Diffstat (limited to 'lisp/gnus/nnimap.el')
-rw-r--r-- | lisp/gnus/nnimap.el | 20 |
1 files changed, 16 insertions, 4 deletions
diff --git a/lisp/gnus/nnimap.el b/lisp/gnus/nnimap.el index ced55619881..8e81abcf9c0 100644 --- a/lisp/gnus/nnimap.el +++ b/lisp/gnus/nnimap.el @@ -166,14 +166,21 @@ textual parts.") (nnimap-find-process-buffer nntp-server-buffer)) (defun nnimap-header-parameters () - (format "(UID RFC822.SIZE BODYSTRUCTURE %s)" - (format + (let (params) + (push "UID" params) + (push "RFC822.SIZE" params) + (when (nnimap-capability "X-GM-EXT-1") + (push "X-GM-LABELS" params)) + (push "BODYSTRUCTURE" params) + (push (format (if (nnimap-ver4-p) "BODY.PEEK[HEADER.FIELDS %s]" "RFC822.HEADER.LINES %s") (append '(Subject From Date Message-Id References In-Reply-To Xref) - nnmail-extra-headers)))) + nnmail-extra-headers)) + params) + (format "%s" (nreverse params)))) (deffoo nnimap-retrieve-headers (articles &optional group server fetch-old) (when group @@ -197,7 +204,7 @@ textual parts.") (defun nnimap-transform-headers () (goto-char (point-min)) - (let (article lines size string) + (let (article lines size string labels) (block nil (while (not (eobp)) (while (not (looking-at "\\* [0-9]+ FETCH")) @@ -232,6 +239,9 @@ textual parts.") t) (match-string 1))) (beginning-of-line) + (when (search-forward "X-GM-LABELS" (line-end-position) t) + (setq labels (ignore-errors (read (current-buffer))))) + (beginning-of-line) (when (search-forward "BODYSTRUCTURE" (line-end-position) t) (let ((structure (ignore-errors (read (current-buffer))))) @@ -251,6 +261,8 @@ textual parts.") (insert (format "Chars: %s\n" size))) (when lines (insert (format "Lines: %s\n" lines))) + (when labels + (insert (format "X-GM-LABELS: %s\n" labels))) ;; Most servers have a blank line after the headers, but ;; Davmail doesn't. (unless (re-search-forward "^\r$\\|^)\r?$" nil t) |