[PATCH v1 2/2] emacs: show: Wrap headers for display

[David Edmondson <dme@dme.org>]

When displaying mail headers, wrap them to the width of the window
used for display. Attempt to do so at appropriate boundaries.
---
 emacs/notmuch-show.el | 125 +++++++++++++++++++++++++++++++++-----------------
 1 file changed, 83 insertions(+), 42 deletions(-)

diff --git a/emacs/notmuch-show.el b/emacs/notmuch-show.el
index 677405ba..10f0233c 100644
--- a/emacs/notmuch-show.el
+++ b/emacs/notmuch-show.el
@@ -79,10 +79,6 @@ visible for any given message."
   :type 'boolean
   :group 'notmuch-show)
 
-(defvar notmuch-show-markup-headers-hook '(notmuch-show-colour-headers)
-  "A list of functions called to decorate the headers listed in
-`notmuch-message-headers'.")
-
 (defcustom notmuch-show-hook '(notmuch-show-turn-on-visual-line-mode)
   "Functions called after populating a `notmuch-show' buffer."
   :type 'hook
@@ -343,29 +339,6 @@ operation on the contents of the current buffer."
   (interactive)
   (notmuch-show-with-message-as-text 'notmuch-print-message))
 
-(defun notmuch-show-fontify-header ()
-  (let ((face (cond
-	       ((looking-at " *[Tt]o:")
-		'message-header-to)
-	       ((looking-at " *[Bb]?[Cc][Cc]:")
-		'message-header-cc)
-	       ((looking-at " *[Ss]ubject:")
-		'message-header-subject)
-	       (t
-		'message-header-other))))
-
-    (overlay-put (make-overlay (point) (re-search-forward ":"))
-		 'face 'message-header-name)
-    (overlay-put (make-overlay (point) (re-search-forward ".*$"))
-		 'face face)))
-
-(defun notmuch-show-colour-headers ()
-  "Apply some colouring to the current headers."
-  (goto-char (point-min))
-  (while (looking-at "^ *[A-Za-z][-A-Za-z0-9]*:")
-    (notmuch-show-fontify-header)
-    (forward-line)))
-
 (defun notmuch-show-spaces-n (n)
   "Return a string comprised of `n' spaces."
   (make-string n ? ))
@@ -460,25 +433,93 @@ message at DEPTH in the current thread."
 	    ")\n")
     (overlay-put (make-overlay start (point)) 'face 'notmuch-message-summary-face)))
 
+(defun notmuch-show--wrap-header (header width separator)
+  "Wrap a HEADER for display in WIDTH characters splitting at
+SEPARATOR. Returns a list of strings."
+  (let* ((split-header (split-string header separator))
+	 (n-element (length split-header))
+	 (nth 1)
+	 this-result results)
+    (mapc (lambda (element)
+	    ;; If this is not the last element, we will need a
+	    ;; separator.
+	    (let ((element-and-separator
+		   (concat element (unless (eq nth n-element) separator))))
+	      (if (> (+ (length this-result)
+			(length element-and-separator))
+		     width)
+		  ;; Adding this element to that already collected
+		  ;; would overflow the width, so record anything
+		  ;; already collected and reset the collection to
+		  ;; just this element.
+		  (if this-result
+		      (progn
+			(push this-result results)
+			(setq this-result element-and-separator))
+		    (push element-and-separator results))
+		;; Add this element to anything already collected.
+		(setq this-result (concat this-result element-and-separator)))
+	      (setq nth (+ 1 nth))))
+	  split-header)
+    ;; If anything was left in the collection buffer, record it.
+    (when this-result
+      (push this-result results))
+    (reverse results)))
+
+(defun notmuch-show--face-for-header (header)
+  "Return the face to use to highlight HEADER."
+  (cond
+   ((string= "To" header)
+    'message-header-to)
+   ((or (string= "Cc" header)
+	(string= "Bcc" header))
+    'message-header-cc)
+   ((string= "Subject" header)
+    'message-header-subject)
+   (t
+    'message-header-other)))
+
+(defun notmuch-show--separator-for-header (header)
+  "What separator should be used when splitting HEADER?"
+  (cond
+   ((or (string= "To" header)
+	(string= "Cc" header)
+	(string= "Bcc" header)
+	(string= "From" header))
+    ", ")
+   (t
+    " ")))
+
 (defun notmuch-show-insert-header (header header-value)
-  "Insert a single header."
-  ;; `7' because `Subject' is the longest header.
-  (insert (format "%7s: %s\n" header (notmuch-sanitize header-value))))
+  "Insert HEADER with value HEADER-VALUE."
+  (let* ((value-face (notmuch-show--face-for-header header))
+	 (separator (notmuch-show--separator-for-header header))
+	 ;; `9' due to the header name and `: '.
+	 (width (- (window-width) 9))
+	 (header-lines (notmuch-show--wrap-header
+			(notmuch-sanitize header-value) width separator))
+	 (first-header (car header-lines))
+	 (remaining-header-lines (cdr header-lines)))
+
+    ;; `7' because `Subject' is the longest header.
+    (insert (format "%7s: %s\n"
+		    (propertize header 'face 'message-header-name)
+		    (propertize first-header 'face value-face)))
+
+    (mapc (lambda (header)
+	    (insert (format "%7s  %s\n" ""
+			    (propertize header 'face value-face))))
+	  remaining-header-lines)))
 
 (defun notmuch-show-insert-headers (headers)
   "Insert the headers of the current message."
-  (let ((start (point)))
-    (mapc (lambda (header)
-	    (let* ((header-symbol (intern (concat ":" header)))
-		   (header-value (plist-get headers header-symbol)))
-	      (if (and header-value
-		       (not (string-equal "" header-value)))
-		  (notmuch-show-insert-header header header-value))))
-	  notmuch-message-headers)
-    (save-excursion
-      (save-restriction
-	(narrow-to-region start (point-max))
-	(run-hooks 'notmuch-show-markup-headers-hook)))))
+  (mapc (lambda (header)
+	  (let* ((header-symbol (intern (concat ":" header)))
+		 (header-value (plist-get headers header-symbol)))
+	    (if (and header-value
+		     (not (string-equal "" header-value)))
+		(notmuch-show-insert-header header header-value))))
+	notmuch-message-headers))
 
 (define-button-type 'notmuch-show-part-button-type
   'action 'notmuch-show-part-button-default
-- 
2.11.0