Make internal nnimap moving slightly faster.

[gnus] / lisp / nnimap.el

diff --git a/lisp/nnimap.el b/lisp/nnimap.el
index 63f3a2d..d7dc1fb 100644 (file)
--- a/lisp/nnimap.el
+++ b/lisp/nnimap.el
@@ -136,6 +136,16 @@ textual parts.")
 (defun nnimap-buffer ()
   (nnimap-find-process-buffer nntp-server-buffer))
 
+(defun nnimap-header-parameters ()
+  (format "(UID RFC822.SIZE BODYSTRUCTURE %s)"
+         (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))))
+
 (deffoo nnimap-retrieve-headers (articles &optional group server fetch-old)
   (with-current-buffer nntp-server-buffer
     (erase-buffer)
@@ -146,14 +156,7 @@ textual parts.")
         (nnimap-send-command
          "UID FETCH %s %s"
          (nnimap-article-ranges (gnus-compress-sequence articles))
-         (format "(UID RFC822.SIZE BODYSTRUCTURE %s)"
-                 (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))))
+         (nnimap-header-parameters))
         t)
        (nnimap-transform-headers))
       (insert-buffer-substring
@@ -477,7 +480,7 @@ textual parts.")
                                (let ((start (point)))
                                  (forward-sexp 1)
                                  (downcase-region start (point))
-                                 (goto-char (point))
+                                 (goto-char start)
                                  (read (current-buffer))))
                    parts (nnimap-find-wanted-parts structure))))
          (when (if parts
@@ -490,12 +493,28 @@ textual parts.")
                (nnheader-ms-strip-cr)
                (cons group article)))))))))
 
-(defun nnimap-get-whole-article (article)
+(deffoo nnimap-request-head (article &optional group server to-buffer)
+  (when (nnimap-possibly-change-group group server)
+    (with-current-buffer (nnimap-buffer)
+      (when (stringp article)
+       (setq article (nnimap-find-article-by-message-id group article)))
+      (nnimap-get-whole-article
+       article (format "UID FETCH %%d %s"
+                      (nnimap-header-parameters)))
+      (let ((buffer (current-buffer)))
+       (with-current-buffer (or to-buffer nntp-server-buffer)
+         (erase-buffer)
+         (insert-buffer-substring buffer)
+         (nnheader-ms-strip-cr)
+         (cons group article))))))
+
+(defun nnimap-get-whole-article (article &optional command)
   (let ((result
         (nnimap-command
-         (if (nnimap-ver4-p)
-             "UID FETCH %d BODY.PEEK[]"
-           "UID FETCH %d RFC822.PEEK")
+         (or command
+             (if (nnimap-ver4-p)
+                 "UID FETCH %d BODY.PEEK[]"
+               "UID FETCH %d RFC822.PEEK"))
          article)))
     ;; Check that we really got an article.
     (goto-char (point-min))
@@ -565,9 +584,9 @@ textual parts.")
        (pop bstruc))
       (setq type (car bstruc))
       (setq bstruc (car (cdr bstruc)))
-      (when (and (stringp (car bstruc))
-                (string= (downcase (car bstruc)) "boundary"))
-       (setq boundary (cadr bstruc))))
+      (let ((has-boundary (member "boundary" bstruc)))
+        (when has-boundary
+          (setq boundary (cadr has-boundary)))))
     (when subp
       (insert (format "Content-type: multipart/%s; boundary=%S\n\n"
                      (downcase type) boundary)))
@@ -714,7 +733,11 @@ textual parts.")
 (deffoo nnimap-request-move-article (article group server accept-form
                                             &optional last internal-move-group)
   (with-temp-buffer
-    (when (nnimap-request-article article group server (current-buffer))
+    (mm-disable-multibyte)
+    (when (funcall (if internal-move-group
+                      'nnimap-request-head
+                    'nnimap-request-article)
+                  article group server (current-buffer))
       ;; If the move is internal (on the same server), just do it the easy
       ;; way.
       (let ((message-id (message-field-value "message-id")))
@@ -769,6 +792,7 @@ textual parts.")
     (dolist (article articles)
       (let ((target nnmail-expiry-target))
        (with-temp-buffer
+          (mm-disable-multibyte)
          (when (nnimap-request-article article group server (current-buffer))
            (nnheader-message 7 "Expiring article %s:%d" group article)
            (when (functionp target)
@@ -879,7 +903,7 @@ textual parts.")
     (let ((message-id (message-field-value "message-id"))
          sequence message)
       (nnimap-add-cr)
-      (setq message (buffer-string))
+      (setq message (buffer-substring-no-properties (point-min) (point-max)))
       (with-current-buffer (nnimap-buffer)
        (setq sequence (nnimap-send-command
                        "APPEND %S {%d}" (utf7-encode group t)
@@ -897,6 +921,17 @@ textual parts.")
            (cons group
                  (nnimap-find-article-by-message-id group message-id))))))))
 
+(deffoo nnimap-request-replace-article (article group buffer)
+  (let (group-art)
+    (when (and (nnimap-possibly-change-group group nil)
+              ;; Put the article into the group.
+              (with-current-buffer buffer
+                (setq group-art
+                      (nnimap-request-accept-article group nil t))))
+      (nnimap-delete-article (list article))
+      ;; Return the new article number.
+      (cdr group-art))))
+
 (defun nnimap-add-cr ()
   (goto-char (point-min))
   (while (re-search-forward "\r?\n" nil t)
@@ -1474,6 +1509,7 @@ textual parts.")
 (defun nnimap-parse-line (line)
   (let (char result)
     (with-temp-buffer
+      (mm-disable-multibyte)
       (insert line)
       (goto-char (point-min))
       (while (not (eobp))