[Emacs-diffs] master 242354a: lisp/gnus/nnimap.el Allow using the Google X-GM-LABELS, if present

[Katsumi Yamaoka]

branch: master
commit 242354a23acf214ad06d4e3e7e5f5580c8b21d4a
Author: Trevor Murphy <address@hidden>
Commit: Katsumi Yamaoka <address@hidden>

    lisp/gnus/nnimap.el Allow using the Google X-GM-LABELS, if present
---
 lisp/gnus/ChangeLog |    6 ++++++
 lisp/gnus/nnimap.el |   20 ++++++++++++++++----
 2 files changed, 22 insertions(+), 4 deletions(-)

diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog
index 7ef526b..2f3f375 100644
--- a/lisp/gnus/ChangeLog
+++ b/lisp/gnus/ChangeLog
@@ -1,3 +1,9 @@
+2015-01-26  Trevor Murphy  <address@hidden>
+
+       * 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  <address@hidden>
 
        * mm-decode.el (mm-display-part): Make non-string methods work.
diff --git a/lisp/gnus/nnimap.el b/lisp/gnus/nnimap.el
index ced5561..8e81abc 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)