el/dot-emacs.el: Hack Gnus to cope with IMAP literals properly.

The bug manifests when Dovecot encounters a MIME-part header of the form

	Content-Description:
		BLAH...

Gnus requests `BODYSTRUCTURE' as part of its `FETCH' command.  In the
specific case shown above, Dovecot encodes the description using IMAP
`literal' quoting, as

	{LEN}

		BLAH...

(The first newline is part of the literal syntax; and the second is part
of the header data.  Actually, the first newline is an IETF-style
carriage-return/line-feed pair, and the second is a bare linefeed, but
that doesn't matter here.)

Gnus has a loop which converts such strings into plain double-quoted
strings, but it can't cope with two consecutive such strings.
Specifically, it ends up with

	... " BLAH"| {LEN} ...

with point at the `|', but expects to find at least two characters
before the next `{LEN}'.  Hacky fix: move back by one place before
resuming the search.

Much worse is the need to include the entire function here so that I can
patch it just a little.

diff --git a/el/dot-emacs.el b/el/dot-emacs.el
index 17ca3bba74d322ce60d4a01a33880e3219548c7a..d99134d7a9868e03128706d83c9af1a485c7f423 100644 (file)
--- a/el/dot-emacs.el
+++ b/el/dot-emacs.el
@@ -752,6 +752,78 @@ (defun nntp-open-authinfo-kludge (buffer)
 (eval-after-load "erc"
   '(load "~/.ercrc.el"))
 
+;; Heavy-duty Gnus patching.
+
+(defun mdw-nnimap-transform-headers ()
+  (goto-char (point-min))
+  (let (article lines size string)
+    (block nil
+      (while (not (eobp))
+       (while (not (looking-at "\\* [0-9]+ FETCH"))
+         (delete-region (point) (progn (forward-line 1) (point)))
+         (when (eobp)
+           (return)))
+       (goto-char (match-end 0))
+       ;; Unfold quoted {number} strings.
+       (while (re-search-forward
+               "[^]][ (]{\\([0-9]+\\)}\r?\n"
+               (save-excursion
+                 ;; Start of the header section.
+                 (or (re-search-forward "] {[0-9]+}\r?\n" nil t)
+                     ;; Start of the next FETCH.
+                     (re-search-forward "\\* [0-9]+ FETCH" nil t)
+                     (point-max)))
+               t)
+         (setq size (string-to-number (match-string 1)))
+         (delete-region (+ (match-beginning 0) 2) (point))
+         (setq string (buffer-substring (point) (+ (point) size)))
+         (delete-region (point) (+ (point) size))
+         (insert (format "%S" (mm-subst-char-in-string ?\n ?\s string)))
+         ;; [mdw] missing from upstream
+         (backward-char 1))
+       (beginning-of-line)
+       (setq article
+             (and (re-search-forward "UID \\([0-9]+\\)" (line-end-position)
+                                     t)
+                  (match-string 1)))
+       (setq lines nil)
+       (setq size
+             (and (re-search-forward "RFC822.SIZE \\([0-9]+\\)"
+                                     (line-end-position)
+                                     t)
+                  (match-string 1)))
+       (beginning-of-line)
+       (when (search-forward "BODYSTRUCTURE" (line-end-position) t)
+         (let ((structure (ignore-errors
+                            (read (current-buffer)))))
+           (while (and (consp structure)
+                       (not (atom (car structure))))
+             (setq structure (car structure)))
+           (setq lines (if (and
+                            (stringp (car structure))
+                            (equal (upcase (nth 0 structure)) "MESSAGE")
+                            (equal (upcase (nth 1 structure)) "RFC822"))
+                           (nth 9 structure)
+                         (nth 7 structure)))))
+       (delete-region (line-beginning-position) (line-end-position))
+       (insert (format "211 %s Article retrieved." article))
+       (forward-line 1)
+       (when size
+         (insert (format "Chars: %s\n" size)))
+       (when lines
+         (insert (format "Lines: %s\n" lines)))
+       ;; Most servers have a blank line after the headers, but
+       ;; Davmail doesn't.
+       (unless (re-search-forward "^\r$\\|^)\r?$" nil t)
+         (goto-char (point-max)))
+       (delete-region (line-beginning-position) (line-end-position))
+       (insert ".")
+       (forward-line 1)))))
+
+(eval-after-load 'nnimap
+  '(defalias 'nnimap-transform-headers
+     (symbol-function 'mdw-nnimap-transform-headers)))
+
 ;;;--------------------------------------------------------------------------
 ;;; Utility functions.