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