User-Agent: OpenSMTPD enqueuer (Demoostik)
From: David Edmondson <dme@dme.org>
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>
Precedence: list

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