From 33e63bb7d657f4ffd01f7ee587ba807edebfab9a Mon Sep 17 00:00:00 2001 From: David Edmondson Date: Tue, 25 Nov 2014 09:06:56 +0000 Subject: [PATCH] [RFC][PATCH v2] emacs: Replace `notmuch-search-result-format' evaluation. --- 4f/f5cbf90ed6e5b0eae8e6b8623d7f9bd2bdb05c | 407 ++++++++++++++++++++++ 1 file changed, 407 insertions(+) create mode 100644 4f/f5cbf90ed6e5b0eae8e6b8623d7f9bd2bdb05c diff --git a/4f/f5cbf90ed6e5b0eae8e6b8623d7f9bd2bdb05c b/4f/f5cbf90ed6e5b0eae8e6b8623d7f9bd2bdb05c new file mode 100644 index 000000000..43c7c33ae --- /dev/null +++ b/4f/f5cbf90ed6e5b0eae8e6b8623d7f9bd2bdb05c @@ -0,0 +1,407 @@ +Return-Path: +X-Original-To: notmuch@notmuchmail.org +Delivered-To: notmuch@notmuchmail.org +Received: from localhost (localhost [127.0.0.1]) + by olra.theworths.org (Postfix) with ESMTP id D7A20431FC3 + for ; Tue, 25 Nov 2014 01:07:07 -0800 (PST) +X-Virus-Scanned: Debian amavisd-new at olra.theworths.org +X-Spam-Flag: NO +X-Spam-Score: -0.699 +X-Spam-Level: +X-Spam-Status: No, score=-0.699 tagged_above=-999 required=5 + tests=[RCVD_IN_DNSWL_LOW=-0.7, UNPARSEABLE_RELAY=0.001] + autolearn=disabled +Received: from olra.theworths.org ([127.0.0.1]) + by localhost (olra.theworths.org [127.0.0.1]) (amavisd-new, port 10024) + with ESMTP id Pv2Yf5HeDRTb for ; + Tue, 25 Nov 2014 01:07:00 -0800 (PST) +Received: from mail-wg0-f50.google.com (mail-wg0-f50.google.com + [74.125.82.50]) (using TLSv1 with cipher RC4-SHA (128/128 bits)) (No client + certificate requested) by olra.theworths.org (Postfix) with ESMTPS id + 1316F431FAF for ; Tue, 25 Nov 2014 01:07:00 -0800 + (PST) +Received: by mail-wg0-f50.google.com with SMTP id k14so228219wgh.23 + for ; Tue, 25 Nov 2014 01:06:59 -0800 (PST) +X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; + d=1e100.net; s=20130820; + h=x-gm-message-state:user-agent:from:to:subject:date:message-id; + bh=qNqAimSRgAqUvWo9JF+eLK4arCODnursqIvPaWAs0Rc=; + b=f1aP94TylBERCxZo3X69WSnqxT+he1v69y9lJtjXKSrcNawt0cSltkdV6x9xHZTsYb + qkeGq0UAYSqhgQTGUCXIC0Z1z6xQCWHZ/72yGuFwl/Dg+aI49m6YhLaM+7HqVeJqzDaw + D5XF+BVpamaZvFDndBmr3w4dvHehAbHfCo3Nc5HpV30rzCP/7jRlSHolqwu3vw3nK8pi + Lh/yKjbcaqwOoi+OqO2KzYx0pIYs+F1xc11ZR2BwBwZZi3vZD1mkcYwPn3broEfTHRv0 + qF/468AbothFn5PO+BGi/OxN1tR3w9npVF205H/uGxXXYqGnlx3bz8qzbbeRVGDhUGsT + 7/Yw== +X-Gm-Message-State: + ALoCoQlPWy1vcm8NEQ9LcepslS0y/vlKKaGrBWsVbKwNHOt9IYSkAZO2bNXlXKC9HS9Pj6pZAXpb +X-Received: by 10.180.92.129 with SMTP id cm1mr6687547wib.33.1416906418764; + Tue, 25 Nov 2014 01:06:58 -0800 (PST) +Received: from disaster-area.hh.sledj.net + ([2a01:348:1a2:1:ea39:35ff:fe2c:a227]) + by mx.google.com with ESMTPSA id s9sm1913937wiz.12.2014.11.25.01.06.57 + for + (version=TLSv1.2 cipher=ECDHE-RSA-AES128-GCM-SHA256 bits=128/128); + Tue, 25 Nov 2014 01:06:58 -0800 (PST) +Received: from localhost (30000@localhost [local]); + by localhost (OpenSMTPD) with ESMTPA id af847ce3; + for ; Tue, 25 Nov 2014 09:06:56 +0000 (UTC) +User-Agent: OpenSMTPD enqueuer (Demoostik) +From: David Edmondson +To: notmuch@notmuchmail.org +Subject: [RFC][PATCH v2] emacs: Replace `notmuch-search-result-format' + evaluation. +Date: Tue, 25 Nov 2014 09:06:56 +0000 +Message-Id: <1416906416-3952-1-git-send-email-dme@dme.org> +X-Mailer: git-send-email 2.1.3 +X-BeenThere: notmuch@notmuchmail.org +X-Mailman-Version: 2.1.13 +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: Tue, 25 Nov 2014 09:07:08 -0000 + +Alternative implementation of code that interprets +`notmuch-search-result-format' to insert the results of a search. +--- + +Added some more documentation, as per bremner. + + emacs/notmuch.el | 300 +++++++++++++++++++++++++++++++++---------------------- + 1 file changed, 178 insertions(+), 122 deletions(-) + +diff --git a/emacs/notmuch.el b/emacs/notmuch.el +index 218486a..eb79a29 100644 +--- a/emacs/notmuch.el ++++ b/emacs/notmuch.el +@@ -66,23 +66,103 @@ + "Placeholder variable when notmuch-version.el[c] is not available.")) + + (defcustom notmuch-search-result-format +- `(("date" . "%12s ") +- ("count" . "%-7s ") +- ("authors" . "%-20s ") +- ("subject" . "%s ") +- ("tags" . "(%s)")) +- "Search result formatting. Supported fields are: +- date, count, authors, subject, tags +-For example: +- (setq notmuch-search-result-format \(\(\"authors\" . \"%-40s\"\) +- \(\"subject\" . \"%s\"\)\)\) +-Line breaks are permitted in format strings (though this is +-currently experimental). Note that a line break at the end of an +-\"authors\" field will get elided if the authors list is long; +-place it instead at the beginning of the following field. To +-enter a line break when setting this variable with setq, use \\n. +-To enter a line break in customize, press \\[quoted-insert] C-j." +- :type '(alist :key-type (string) :value-type (string)) ++ '((:width -12 :date_relative) " " ++ (:width -7 (:concat "[" :matched "/" :total "]")) " " ++ ;; This splitting will not be necessary once ++ ;; id:1414172643-28270-1-git-send-email-dme@dme.org is integrated. ++ (:width 40 (:eval (let* ((split-authors (split-string ++ (plist-get notmuch-thread :authors) ++ "|" t split-string-default-separators)) ++ ;; There will always be matched authors. ++ (matched-authors (car split-authors)) ++ ;; There may not be non-matched authors. ++ (non-matched-authors (mapconcat #'identity (cdr split-authors) " "))) ++ (notmuch-search-format-authors matched-authors non-matched-authors)))) " " ++ :subject " " ++ "(" (:eval (notmuch-tag-format-tags (plist-get notmuch-thread :tags) ++ (plist-get notmuch-thread :orig-tags))) ++ ")" "\n") ++ ++ "Template for displaying search results. ++ ++The value is a list of items to insert in the search ++results. Individual items should be in one of the following ++forms: ++ ++A string that is inserted directly (e.g. \" \"). ++ ++A number that is inserted directly (e.g. 5). ++ ++A list that is recursively evaluated (e.g. `(:concat FORM1 ++ FORM2)'). ++ ++A function that is evaluated with a single argument, the current ++ thread. ++ ++A symbol corresponding to an attribute of the ++ thread. Currently available attributes include: ++ ++ :date_relative -- a user-readable rendering of the Date: header ++ of the first matching message in the thread, as a string. ++ ++ :timestamp -- the number of seconds since the Epoch, 1970-01-01 ++ 00:00:00 +0000 (UTC), corresponding to the Date: header of the ++ first matching message in the thread. ++ ++ :subject -- the subject of the first matching message in the ++ thread as a string. ++ ++ :authors -- a comma separated string containing a list of the ++ authors of messages in the thread. If there are non-matching ++ authors (i.e. the thread contains messages which did not match ++ the search terms and those messages have authors who are not ++ also authors of messages that did match the search terms) then ++ the matching and non-matching authors are separated by a `|' ++ symbol in the results in place of a comma. ++ ++ :matched -- the number of messages that matched search terms in ++ the thread (a number). ++ ++ :total -- the total number of messages in the thread (i.e. the ++ count of both matching and non-matching messages). ++ ++ :tags -- a list of tags associated with messages in the ++ thread. Each tag is included as a distinct string. ++ ++ :orig-tags -- a list of tags that were associated with messages ++ in the thread when the search originally took place. ++ ++ :query -- a list with two elements. The first element is a query ++ string that will return all of the matching messages in the ++ current thread. The second element is a query string that will ++ return all of the non-matching messages in the current thread. ++ ++ :thread -- the thread id of the matching thread, as a string. ++ ++ For a full list of the attributes available, see the source code ++ for notmuch itself. ++ ++A directive that describes how to evaluate the remainder of the ++ list. The following directives are available: ++ ++ `:concat FORM...' -- evaluate each element of FORM and return ++ the concatenated results. ++ ++ `:width WIDTH FORM' -- evaluate FORM and return the result ++ truncated to WIDTH characters. The result will be padded with ++ spaces to WIDTH characters, with padding at on the left if the ++ WIDTH is negative. ++ ++ `:tag TAG FORM' -- if the thread has the tag TAG, insert the ++ result of evaluating FORM. ++ ++ `:eval COMPLEX-FORM' -- evaluate COMPLEX-FORM as emacs lisp and ++ evaluate the result. ++ ++During the evaluation of `notmuch-search-result-format', the ++symbol `notmuch-thread' is bound to the current thread (a ++property list), which can then be used in `:eval' forms." ++ :type 'list + :group 'notmuch-search) + + ;; The name of this variable `notmuch-init-file' is consistent with the +@@ -672,109 +752,84 @@ foreground and blue background." + ;; Reverse the list so earlier entries take precedence + (reverse notmuch-search-line-faces))) + +-(defun notmuch-search-author-propertize (authors) +- "Split `authors' into matching and non-matching authors and +-propertize appropriately. If no boundary between authors and +-non-authors is found, assume that all of the authors match." +- (if (string-match "\\(.*\\)|\\(.*\\)" authors) +- (concat (propertize (concat (match-string 1 authors) ",") +- 'face 'notmuch-search-matching-authors) +- (propertize (match-string 2 authors) +- 'face 'notmuch-search-non-matching-authors)) +- (propertize authors 'face 'notmuch-search-matching-authors))) +- +-(defun notmuch-search-insert-authors (format-string authors) +- ;; Save the match data to avoid interfering with +- ;; `notmuch-search-process-filter'. +- (save-match-data +- (let* ((formatted-authors (format format-string authors)) +- (formatted-sample (format format-string "")) +- (visible-string formatted-authors) +- (invisible-string "") +- (padding "")) +- +- ;; Truncate the author string to fit the specification. +- (if (> (length formatted-authors) +- (length formatted-sample)) +- (let ((visible-length (- (length formatted-sample) +- (length "... ")))) +- ;; Truncate the visible string according to the width of +- ;; the display string. +- (setq visible-string (substring formatted-authors 0 visible-length) +- invisible-string (substring formatted-authors visible-length)) +- ;; If possible, truncate the visible string at a natural +- ;; break (comma or pipe), as incremental search doesn't +- ;; match across the visible/invisible border. +- (when (string-match "\\(.*\\)\\([,|] \\)\\([^,|]*\\)" visible-string) +- ;; Second clause is destructive on `visible-string', so +- ;; order is important. +- (setq invisible-string (concat (match-string 3 visible-string) +- invisible-string) +- visible-string (concat (match-string 1 visible-string) +- (match-string 2 visible-string)))) +- ;; `visible-string' may be shorter than the space allowed +- ;; by `format-string'. If so we must insert some padding +- ;; after `invisible-string'. +- (setq padding (make-string (- (length formatted-sample) +- (length visible-string) +- (length "...")) +- ? )))) +- +- ;; Use different faces to show matching and non-matching authors. +- (if (string-match "\\(.*\\)|\\(.*\\)" visible-string) +- ;; The visible string contains both matching and +- ;; non-matching authors. +- (setq visible-string (notmuch-search-author-propertize visible-string) +- ;; The invisible string must contain only non-matching +- ;; authors, as the visible-string contains both. +- invisible-string (propertize invisible-string +- 'face 'notmuch-search-non-matching-authors)) +- ;; The visible string contains only matching authors. +- (setq visible-string (propertize visible-string +- 'face 'notmuch-search-matching-authors) +- ;; The invisible string may contain both matching and +- ;; non-matching authors. +- invisible-string (notmuch-search-author-propertize invisible-string))) +- +- ;; If there is any invisible text, add it as a tooltip to the +- ;; visible text. +- (when (not (string= invisible-string "")) +- (setq visible-string (propertize visible-string 'help-echo (concat "..." invisible-string)))) +- +- ;; Insert the visible and, if present, invisible author strings. +- (insert visible-string) +- (when (not (string= invisible-string "")) +- (let ((start (point)) +- overlay) +- (insert invisible-string) +- (setq overlay (make-overlay start (point))) +- (overlay-put overlay 'invisible 'ellipsis) +- (overlay-put overlay 'isearch-open-invisible #'delete-overlay))) +- (insert padding)))) +- +-(defun notmuch-search-insert-field (field format-string result) ++(defun notmuch-search-format-authors (matched non-matched) ++ (if (string-equal "" non-matched) ++ (propertize matched 'face 'notmuch-search-matching-authors) ++ (concat (propertize (concat matched ", ") ++ 'face 'notmuch-search-matching-authors) ++ (propertize non-matched ++ 'face 'notmuch-search-non-matching-authors)))) ++ ++(defun notmuch-search-make-width (width string) ++ (let ((neg (< 0 width)) ++ (width (abs width)) ++ (orig-len (length string))) ++ ++ (if (< width orig-len) ++ ;; A sub-set of the string will be visible. ++ (let* ((ellipsis "...") ++ (visible-len (- width (length ellipsis))) ++ (visible-string (substring string 0 visible-len)) ++ (invisible-string (substring string visible-len))) ++ ++ (concat (propertize (concat visible-string ++ ;; The ellipsis should share the ++ ;; face of the preceding ++ ;; character. ++ (propertize ellipsis 'face ++ (get-text-property visible-len 'face string))) ++ 'help-echo (concat ellipsis invisible-string)))) ++ ++ ;; All of the string is visible - pad it. ++ (concat (if neg string) ++ (make-string (- width orig-len) ? ) ++ (if neg "" string))))) ++ ++(defun notmuch-search-elem-repr (elem thread) + (cond +- ((string-equal field "date") +- (insert (propertize (format format-string (plist-get result :date_relative)) +- 'face 'notmuch-search-date))) +- ((string-equal field "count") +- (insert (propertize (format format-string +- (format "[%s/%s]" (plist-get result :matched) +- (plist-get result :total))) +- 'face 'notmuch-search-count))) +- ((string-equal field "subject") +- (insert (propertize (format format-string +- (notmuch-sanitize (plist-get result :subject))) +- 'face 'notmuch-search-subject))) +- +- ((string-equal field "authors") +- (notmuch-search-insert-authors +- format-string (notmuch-sanitize (plist-get result :authors)))) +- +- ((string-equal field "tags") +- (let ((tags (plist-get result :tags)) +- (orig-tags (plist-get result :orig-tags))) +- (insert (format format-string (notmuch-tag-format-tags tags orig-tags))))))) ++ ((not elem) ++ "") ++ ++ ((numberp elem) ++ (format "%d" elem)) ++ ++ ((stringp elem) ++ elem) ++ ++ ((functionp elem) ++ (funcall elem thread)) ++ ++ ((listp elem) ++ (let ((op (car elem)) ++ (rest (cdr elem))) ++ (case op ++ (:concat ++ (mapconcat (lambda (inner-elem) ++ (notmuch-search-elem-repr inner-elem thread)) ++ rest "")) ++ ++ (:width ++ (notmuch-search-make-width (car rest) ++ (notmuch-search-elem-repr (cadr rest) thread))) ++ ++ (:tag ++ (when (member (car rest) (plist-get thread :tags)) ++ (notmuch-search-elem-repr (cadr rest) thread))) ++ ++ (:eval ++ (notmuch-search-elem-repr (apply #'eval rest) thread)) ++ ++ (otherwise ++ (mapconcat ++ (lambda (inner-elem) (notmuch-search-elem-repr inner-elem thread)) ++ elem ""))))) ++ ++ (t ++ (let ((val (plist-get thread elem))) ++ (if val ++ (notmuch-search-elem-repr val thread) ++ (message "Unknown message attribute in `notmuch-search-elem-repr': %s" elem) ++ ""))))) + + (defun notmuch-search-show-result (result pos) + "Insert RESULT at POS." +@@ -782,9 +837,10 @@ non-authors is found, assume that all of the authors match." + (unless (= (plist-get result :matched) 0) + (save-excursion + (goto-char pos) +- (dolist (spec notmuch-search-result-format) +- (notmuch-search-insert-field (car spec) (cdr spec) result)) +- (insert "\n") ++ ;; `notmuch-thread' is a well known symbol for functions to ++ ;; use during evaluation of `notmuch-search-result-format'. ++ (insert (let ((notmuch-thread result)) ++ (notmuch-search-elem-repr notmuch-search-result-format notmuch-thread))) + (notmuch-search-color-line pos (point) (plist-get result :tags)) + (put-text-property pos (point) 'notmuch-search-result result)))) + +-- +2.1.3 + -- 2.26.2