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
_______________________________________________
notmuch mailing list
notmuch@notmuchmail.org
https://notmuchmail.org/mailman/listinfo/notmuch
