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 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. 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

Reply via email to