X-Git-Url: https://git.distorted.org.uk/~mdw/profile/blobdiff_plain/fbc946b7cb685bb47268f036e7fb4ed58ad19cbe..a3857ab280c3cbd4c97e0e3524fe2be069f7572a:/el/dot-emacs.el

diff --git a/el/dot-emacs.el b/el/dot-emacs.el
index 17ca3bb..24d076d 100644
--- a/el/dot-emacs.el
+++ b/el/dot-emacs.el
@@ -200,13 +200,16 @@ fringes is not taken out of the allowance for WIDTH, unlike
 	 ((>= width 0) (+ width (mdw-horizontal-window-overhead)))
 	 ((< width 0) width))))
 
+(defun mdw-preferred-column-width ()
+  "Return the preferred column width."
+  (if (and window-system (mdw-emacs-version-p 22)) mdw-column-width
+    (1+ mdw-column-width)))
+
 (defun mdw-divvy-window (&optional width)
   "Split a wide window into appropriate widths."
   (interactive "P")
-  (setq width (cond (width (prefix-numeric-value width))
-		    ((and window-system (mdw-emacs-version-p 22))
-		     mdw-column-width)
-		    (t (1+ mdw-column-width))))
+  (setq width (if width (prefix-numeric-value width)
+		(mdw-preferred-column-width)))
   (let* ((win (selected-window))
 	 (sb-width (mdw-horizontal-window-overhead))
 	 (c (/ (+ (window-width) sb-width)
@@ -220,10 +223,8 @@ fringes is not taken out of the allowance for WIDTH, unlike
 (defun mdw-set-frame-width (columns &optional width)
   (interactive "nColumns: 
 P")
-  (setq width (cond (width (prefix-numeric-value width))
-		    ((and window-system (mdw-emacs-version-p 22))
-		     mdw-column-width)
-		    (t (1+ mdw-column-width))))
+  (setq width (if width (prefix-numeric-value width)
+		(mdw-preferred-column-width)))
   (let ((sb-width (mdw-horizontal-window-overhead)))
     (set-frame-width (selected-frame)
 		     (- (* columns (+ width sb-width))
@@ -752,6 +753,78 @@ Use this to arrange for per-server settings.")
 (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.