[RFC][PATCH v1] emacs: Replace `notmuch-search-result-format' evaluation.
David Edmondson
dme at dme.org
Mon Nov 24 02:44:29 PST 2014
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 at 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
More information about the notmuch
mailing list