changeset 111168:d1079095427d

Merge changes made in Gnus trunk. message.el (message-default-headers): Fix type. nnimap.el (nnimap-request-head, nnimap-request-move-article): Make internal nnimap moving slightly faster. nnimap.el (nnimap-transform-headers): Don't bug out on bodiless articles. nnimap.el (nnimap-send-command): Have no outstanding messages if the IMAP server doesn't support streaming. nnimap.el (nnimap-transform-headers): Fold {quoted} strings more sloppily.
author Katsumi Yamaoka <yamaoka@jpl.org>
date Sun, 24 Oct 2010 22:32:38 +0000
parents 638eadc53a4f
children d15bf0cd36e1
files doc/misc/message.texi lisp/gnus/ChangeLog lisp/gnus/gnus-int.el lisp/gnus/message.el lisp/gnus/nnimap.el
diffstat 5 files changed, 71 insertions(+), 29 deletions(-) [+]
line wrap: on
line diff
--- a/doc/misc/message.texi	Sun Oct 24 15:07:06 2010 -0700
+++ b/doc/misc/message.texi	Sun Oct 24 22:32:38 2010 +0000
@@ -1450,8 +1450,10 @@
 
 @item message-default-headers
 @vindex message-default-headers
-This string is inserted at the end of the headers in all message
-buffers.  If set to a function, the returned results is inserted.
+Header lines to be inserted in outgoing messages before you edit the
+message, so you can edit or delete their lines. If set to a string, it
+is directly inserted. If set to a function, it is called and its
+result is inserted.
 
 @item message-subject-re-regexp
 @vindex message-subject-re-regexp
--- a/lisp/gnus/ChangeLog	Sun Oct 24 15:07:06 2010 -0700
+++ b/lisp/gnus/ChangeLog	Sun Oct 24 22:32:38 2010 +0000
@@ -1,3 +1,17 @@
+2010-10-24  Lars Magne Ingebrigtsen  <larsi@gnus.org>
+
+	* nnimap.el (nnimap-request-head): New function.
+	(nnimap-request-move-article): Try to be slighly faster by not
+	requesting the entire message when moving.
+	(nnimap-transform-headers): Don't bug out on bodiless articles.
+	(nnimap-send-command): Have no outstanding messages if the IMAP server
+	doesn't support streaming.
+	(nnimap-transform-headers): Fold {quoted} strings more sloppily.
+
+2010-10-24  Julien Danjou  <julien@danjou.info>
+
+	* message.el (message-default-headers): Fix type.
+
 2010-10-24  Lars Magne Ingebrigtsen  <larsi@gnus.org>
 
 	* gnus-html.el (gnus-html-prefetch-images): Decode entities before
--- a/lisp/gnus/gnus-int.el	Sun Oct 24 15:07:06 2010 -0700
+++ b/lisp/gnus/gnus-int.el	Sun Oct 24 22:32:38 2010 +0000
@@ -655,7 +655,8 @@
 	 (result (funcall (gnus-get-function gnus-command-method
 					     'request-move-article)
 			  article (gnus-group-real-name group)
-			  (nth 1 gnus-command-method) accept-function last move-is-internal)))
+			  (nth 1 gnus-command-method) accept-function
+			  last move-is-internal)))
     (when (and result gnus-agent
 	       (gnus-agent-method-p gnus-command-method))
       (gnus-agent-unfetch-articles group (list article)))
--- a/lisp/gnus/message.el	Sun Oct 24 15:07:06 2010 -0700
+++ b/lisp/gnus/message.el	Sun Oct 24 22:32:38 2010 +0000
@@ -1139,14 +1139,17 @@
   :error "All header lines must be newline terminated")
 
 (defcustom message-default-headers ""
-  "A string containing header lines to be inserted in outgoing messages.
-It is inserted before you edit the message, so you can edit or
-delete these lines.  If set to a function, it is called and its
-result is inserted."
+  "Header lines to be inserted in outgoing messages.
+This can be set to a string containing or a function returning
+header lines to be inserted before you edit the message, so you
+can edit or delete these lines.  If set to a function, it is
+called and its result is inserted."
   :version "23.2"
   :group 'message-headers
   :link '(custom-manual "(message)Message Headers")
-  :type 'message-header-lines)
+  :type '(choice
+          (message-header-lines :tag "String")
+          (function :tag "Function")))
 
 (defcustom message-default-mail-headers
   ;; Ease the transition from mail-mode to message-mode.  See bugs#4431, 5555.
--- a/lisp/gnus/nnimap.el	Sun Oct 24 15:07:06 2010 -0700
+++ b/lisp/gnus/nnimap.el	Sun Oct 24 22:32:38 2010 +0000
@@ -136,6 +136,16 @@
 (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 @@
 	 (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
@@ -171,7 +174,7 @@
 	    (return)))
 	(setq article (match-string 1))
 	;; Unfold quoted {number} strings.
-	(while (re-search-forward "[^]] {\\([0-9]+\\)}\r\n"
+	(while (re-search-forward "[^]][ (]{\\([0-9]+\\)}\r\n"
 				  (1+ (line-end-position)) t)
 	  (setq size (string-to-number (match-string 1)))
 	  (delete-region (+ (match-beginning 0) 2) (point))
@@ -200,7 +203,8 @@
 	  (insert (format "Chars: %s\n" size)))
 	(when lines
 	  (insert (format "Lines: %s\n" lines)))
-	(re-search-forward "^\r$")
+	(unless (re-search-forward "^\r$" nil t)
+	  (goto-char (point-max)))
 	(delete-region (line-beginning-position) (line-end-position))
 	(insert ".")
 	(forward-line 1)))))
@@ -490,12 +494,28 @@
 		(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))
@@ -715,7 +735,10 @@
 					     &optional last internal-move-group)
   (with-temp-buffer
     (mm-disable-multibyte)
-    (when (nnimap-request-article article group server (current-buffer))
+    (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")))
@@ -1025,12 +1048,7 @@
 					       (utf7-encode group t))
 			  (nnimap-send-command "UID FETCH %d:* FLAGS" start)
 			  start group command)
-		    sequences)))
-	  ;; Some servers apparently can't have many outstanding
-	  ;; commands, so throttle them.
-	  (when (and (not nnimap-streaming)
-		     (car sequences))
-	    (nnimap-wait-for-response (caar sequences))))
+		    sequences))))
 	sequences))))
 
 (deffoo nnimap-finish-retrieve-group-infos (server infos sequences)
@@ -1408,6 +1426,10 @@
 	    (if (nnimap-newlinep nnimap-object)
 		""
 	      "\r"))))
+  ;; Some servers apparently can't have many outstanding
+  ;; commands, so throttle them.
+  (unless nnimap-streaming
+    (nnimap-wait-for-response nnimap-sequence))
   nnimap-sequence)
 
 (defun nnimap-log-command (command)