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