From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: from localhost (localhost [127.0.0.1]) by arlo.cworth.org (Postfix) with ESMTP id DC9D86DE0005 for ; Wed, 28 Dec 2016 04:18:31 -0800 (PST) X-Virus-Scanned: Debian amavisd-new at cworth.org X-Spam-Flag: NO X-Spam-Score: 0.546 X-Spam-Level: X-Spam-Status: No, score=0.546 tagged_above=-999 required=5 tests=[AWL=-0.087, DKIM_SIGNED=0.1, DKIM_VALID=-0.1, RCVD_IN_DNSWL_NONE=-0.0001, RCVD_IN_MSPIKE_H3=-0.01, RCVD_IN_MSPIKE_WL=-0.01, SPF_NEUTRAL=0.652, UNPARSEABLE_RELAY=0.001] autolearn=disabled Received: from arlo.cworth.org ([127.0.0.1]) by localhost (arlo.cworth.org [127.0.0.1]) (amavisd-new, port 10024) with ESMTP id Mp5NLNwjIsiJ for ; Wed, 28 Dec 2016 04:18:30 -0800 (PST) Received: from mail-wj0-f179.google.com (mail-wj0-f179.google.com [209.85.210.179]) by arlo.cworth.org (Postfix) with ESMTPS id 695686DE0297 for ; Wed, 28 Dec 2016 04:18:30 -0800 (PST) Received: by mail-wj0-f179.google.com with SMTP id sd9so151140336wjb.1 for ; Wed, 28 Dec 2016 04:18:30 -0800 (PST) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=dme-org.20150623.gappssmtp.com; s=20150623; h=from:to:subject:date:message-id:in-reply-to:references; bh=gjg6gb6Ub1HQ2ivfoXyqweSZeidUtRnBdw2CpBLuEMg=; b=VjK9ai7RdGfPM95LAzoz4IFuLZbXlAXcsoHiHZPHO36eYx0zUlRYt42x1otbWz6ix5 NfM7cFBKLoK59FA9gFu5moYfuWL5AA8oxi1oJA/dtwutlsSe6UQ21tB2Z1EfoLFq/ASw hrx/8pUgJV9t2QaZao0cvhCPInMSZNliW7QpKc5JsJAVuzOvheedbiPAa2vWenbHhG/y Qo+wCmZKp/vKUbJKdEoUo2TMqOQyz3KOEWTaJ6R6S7A/CcHj5ShBX8ZE8AkEr35rsMpw qCVbmsZPkB0Qykd3j070Gk4co+ebfVZx1/rEJIW/aWXsCKoPUT9k+I1geb94NivaeiCf GfQw== X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20161025; h=x-gm-message-state:from:to:subject:date:message-id:in-reply-to :references; bh=gjg6gb6Ub1HQ2ivfoXyqweSZeidUtRnBdw2CpBLuEMg=; b=giGNjTcB4Xosy/qtzMgCBXVYhy5+oXl6UfZqyz21SLURPYHiDXzhMpW20wrEL9iZW+ 7BXYQlNNc1Bi3vArVQqIdWvk5JAovvWiP4moyQ7BShDIhmrRk6kdpQ/U3rlXmSHzT3lN 6PDlu7vto3b/fQjKE7JqznNFY/KVuPuQ4SEuznTQEPZ/ckYIkk3GAGUvsmfJD5XKgDKn D6cYMqoW3W4bZt9wlZ1iQOnZMpiwAk2cOa320SQEcsMTQwxJ+3ZRk/Qia3jZFFpjQT2D 1INWOoaUawgjjgX3GjwG1dZzOGkVW7BigbsjxvSRIAAlWbFCjSLZB/ufvJLonOxjBno3 a9nQ== X-Gm-Message-State: AIkVDXI7XDbsouXBaxvDjpjMt2VIsobnh6iGleCK3FSc2VaUmDosHqbYZdua7AzKKlWPiQ== X-Received: by 10.194.105.228 with SMTP id gp4mr31341956wjb.208.1482927508664; Wed, 28 Dec 2016 04:18:28 -0800 (PST) Received: from disaster-area.hh.sledj.net (disaster-area.hh.sledj.net. [81.149.164.25]) by smtp.gmail.com with ESMTPSA id a13sm60809615wma.18.2016.12.28.04.18.27 for (version=TLS1_2 cipher=ECDHE-RSA-AES128-GCM-SHA256 bits=128/128); Wed, 28 Dec 2016 04:18:28 -0800 (PST) Received: from localhost (disaster-area.hh.sledj.net [local]) by disaster-area.hh.sledj.net (OpenSMTPD) with ESMTPA id f49d416c for ; Wed, 28 Dec 2016 12:18:25 +0000 (UTC) From: David Edmondson To: notmuch@notmuchmail.org Subject: [PATCH v1 2/2] emacs: show: Wrap headers for display Date: Wed, 28 Dec 2016 12:18:25 +0000 Message-Id: <20161228121825.11265-3-dme@dme.org> X-Mailer: git-send-email 2.11.0 In-Reply-To: <20161228121825.11265-1-dme@dme.org> References: <20161228121825.11265-1-dme@dme.org> X-BeenThere: notmuch@notmuchmail.org X-Mailman-Version: 2.1.22 Precedence: list List-Id: "Use and development of the notmuch mail system." List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , X-List-Received-Date: Wed, 28 Dec 2016 12:18:32 -0000 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