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

diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog
index 7ef526b425338d4ba595ee86a6572084f69406f3..2f3f3753ebdd314656a1e2ee77e591814db6fc41 100644 (file)
--- a/lisp/gnus/ChangeLog
+++ b/lisp/gnus/ChangeLog
@@ -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.

diff --git a/lisp/gnus/nnimap.el b/lisp/gnus/nnimap.el
index ced556198811f684d8d22cfbd92cae121b2e4407..8e81abcf9c012a53c6b47e26baf239f400fa250c 100644 (file)
--- 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)