procyberian/emacs
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

lisp/gnus/nnimap.el Allow using the Google X-GM-LABELS, if present

Browse source
This commit is contained in:
Trevor Murphy 2015-01-26 07:56:37 +00:00 • committed by Katsumi Yamaoka
parent dafb0ef852
commit 242354a23a
2 changed files with 22 additions and 4 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

6
lisp/gnus/ChangeLog
View file

@ -1,3 +1,9 @@
2015-01-26 Trevor Murphy <trevor.m.murphy@gmail.com>
* nnimap.el (nnimap-header-parameters): Refactor and request
X-GM-LABELS if it's been announced.
(nnimap-transform-headers): Gather and output GM-LABELS.
2015-01-26 Peder O. Klingenberg <peder@klingenberg.no>
* mm-decode.el (mm-display-part): Make non-string methods work.

20
lisp/gnus/nnimap.el
View file

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