From f88af95359d72aee013972b68f4b890072b5c4f5 Mon Sep 17 00:00:00 2001 From: David Edmondson Date: Mon, 24 Nov 2014 10:44:29 +0000 Subject: [PATCH] [RFC][PATCH v1] emacs: Replace `notmuch-search-result-format' evaluation. --- 65/deee0a06a031c3178decdabec5148b8c1d513b | 367 ++++++++++++++++++++++ 1 file changed, 367 insertions(+) create mode 100644 65/deee0a06a031c3178decdabec5148b8c1d513b diff --git a/65/deee0a06a031c3178decdabec5148b8c1d513b b/65/deee0a06a031c3178decdabec5148b8c1d513b new file mode 100644 index 000000000..f86afbafa --- /dev/null +++ b/65/deee0a06a031c3178decdabec5148b8c1d513b @@ -0,0 +1,367 @@ +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 1B933431FC3 + for ; Mon, 24 Nov 2014 02:44:43 -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 4lPDwKPrIUhH for ; + Mon, 24 Nov 2014 02:44:35 -0800 (PST) +Received: from mail-wi0-f175.google.com (mail-wi0-f175.google.com + [209.85.212.175]) (using TLSv1 with cipher RC4-SHA (128/128 bits)) + (No client certificate requested) + by olra.theworths.org (Postfix) with ESMTPS id 726FE431FBC + for ; Mon, 24 Nov 2014 02:44:35 -0800 (PST) +Received: by mail-wi0-f175.google.com with SMTP id l15so5192792wiw.2 + for ; Mon, 24 Nov 2014 02:44:33 -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=xjV5NQcf5hT6+6v4H6Ui+UknvaZ0tlFMq7h6dt3ftcw=; + b=IAUUXQTA8j3CT7nMULZx019XqFkLpngTHZkkuv3U/g4oHUDC0lLKi+ftRwMwPKhyjA + iZVMS62jmBwoU1grLVGHdPzIHfUx40priVekxgiMn/CM21Z1vWX6sBcgaUsHEnjWdjRf + GnbXuUZezDSnv5n45AQ8owQrsumKPiliIuDenbEv/RRFRkEzRxihngSwl3MNULRfMqaf + C2cf2+exXFYV5kJHDc4trLU2FFZYq8eWJe4brPaMiLlxZCHo3rsnHUvgrYqXVRbI4mS8 + R5lu5EW83ZbKbHCnyhTboqof+gBPMhf7yytPexks/PYgzwDwlT2tpYnv1V5EJjkEuilY + r72g== +X-Gm-Message-State: + ALoCoQnCVqWL8ShdLKZCLydMldj9U9lCgORb0ZjY4RU+ohyZ4d37v9Ume2/Gw0+xqxK3WpEFBYyd +X-Received: by 10.194.81.70 with SMTP id y6mr31256421wjx.113.1416825872035; + Mon, 24 Nov 2014 02:44:32 -0800 (PST) +Received: from disaster-area.hh.sledj.net + ([2a01:348:1a2:1:ea39:35ff:fe2c:a227]) + by mx.google.com with ESMTPSA id + ec2sm11434921wib.23.2014.11.24.02.44.31 for + (version=TLSv1.2 cipher=ECDHE-RSA-AES128-GCM-SHA256 bits=128/128); + Mon, 24 Nov 2014 02:44:31 -0800 (PST) +Received: from localhost (30000@localhost [local]); + by localhost (OpenSMTPD) with ESMTPA id 1811d9ff; + for ; Mon, 24 Nov 2014 10:44:29 +0000 (UTC) +User-Agent: OpenSMTPD enqueuer (Demoostik) +From: David Edmondson +To: notmuch@notmuchmail.org +Subject: [RFC][PATCH v1] emacs: Replace `notmuch-search-result-format' + evaluation. +Date: Mon, 24 Nov 2014 10:44:29 +0000 +Message-Id: <1416825869-28472-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: Mon, 24 Nov 2014 10:44:43 -0000 + +Alternative implementation of code that interprets +`notmuch-search-result-format' to insert the results of a search. +--- + +First pass at this. Thoughts? + + emacs/notmuch.el | 260 +++++++++++++++++++++++++++++-------------------------- + 1 file changed, 138 insertions(+), 122 deletions(-) + +diff --git a/emacs/notmuch.el b/emacs/notmuch.el +index 218486a..0490936 100644 +--- a/emacs/notmuch.el ++++ b/emacs/notmuch.el +@@ -66,23 +66,63 @@ + "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 (e.g. `:date_relative' or `:subject'). ++ ++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 +712,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 +797,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