[PATCH] emacs: Allow saved search queries to be dynamically generated.

David Edmondson dme at dme.org
Fri Nov 19 09:49:39 PST 2010


>From an idea by Jed Brown: Allow the query string passed to notmuch by
`notmuch-hello' to be the result of a function as well as a
string. The function is passed no arguments and should return the
search string.

A sample function `notmuch-hello-search-today' is provided.

Update the customisation declaration of `notmuch-saved-searches'
accordingly.
---
 emacs/notmuch-hello.el |  396 +++++++++++++++++++++++++----------------------
 emacs/notmuch-lib.el   |    4 +-
 emacs/notmuch.el       |    9 +-
 3 files changed, 219 insertions(+), 190 deletions(-)

diff --git a/emacs/notmuch-hello.el b/emacs/notmuch-hello.el
index e58dd24..6337f45 100644
--- a/emacs/notmuch-hello.el
+++ b/emacs/notmuch-hello.el
@@ -318,203 +318,229 @@ Complete list of currently available key bindings:
  ;;(setq buffer-read-only t)
 )
 
+(defun notmuch-hello-search-today ()
+  "Return a notmuch search for 'today'.
+
+Convenience function for `notmuch-saved-searches'."
+  (concat
+   (format-time-string "%s" (seconds-to-time
+			     (- (float-time (current-time))
+				(* 60 60 24))))
+   ".."
+   (format-time-string "%s")))
+
+(defun notmuch-hello-generate-saved-searches (saved-searches)
+  (loop for search-tuple in saved-searches
+	collect (cons (car search-tuple)
+		      (let ((search (cdr search-tuple)))
+			(cond
+			 ((functionp search)
+			  (funcall search))
+			 (t ;; Assume a string
+			  search))))))
+
 ;;;###autoload
 (defun notmuch-hello (&optional no-display)
   "Run notmuch and display saved searches, known tags, etc."
   (interactive)
 
-  ; Jump through a hoop to get this value from the deprecated variable
-  ; name (`notmuch-folders') or from the default value.
+  ;; Jump through a hoop to get this value from the deprecated variable
+  ;; name (`notmuch-folders') or from the default value.
   (if (not notmuch-saved-searches)
     (setq notmuch-saved-searches (notmuch-saved-searches)))
 
-  (if no-display
-      (set-buffer "*notmuch-hello*")
-    (switch-to-buffer "*notmuch-hello*"))
-
-  (let ((target (if (widget-at)
-		   (widget-value (widget-at))
-		 (condition-case nil
-		     (progn
-		       (widget-forward 1)
-		       (widget-value (widget-at)))
-		   (error nil)))))
-
-    (kill-all-local-variables)
-    (let ((inhibit-read-only t))
-      (erase-buffer))
-
-    (unless (eq major-mode 'notmuch-hello-mode)
-      (notmuch-hello-mode))
-
-    (let ((all (overlay-lists)))
-      ;; Delete all the overlays.
-      (mapc 'delete-overlay (car all))
-      (mapc 'delete-overlay (cdr all)))
-
-    (when notmuch-show-logo
-      (let ((image notmuch-hello-logo))
-	;; The notmuch logo uses transparency. That can display poorly
-	;; when inserting the image into an emacs buffer (black logo on
-	;; a black background), so force the background colour of the
-	;; image. We use a face to represent the colour so that
-	;; `defface' can be used to declare the different possible
-	;; colours, which depend on whether the frame has a light or
-	;; dark background.
-	(setq image (cons 'image
-			  (append (cdr image)
-				  (list :background (face-background 'notmuch-hello-logo-background)))))
-	(insert-image image))
-      (widget-insert "  "))
-
-    (widget-insert "Welcome to ")
-    ;; Hack the display of the links used.
-    (let ((widget-link-prefix "")
-	  (widget-link-suffix ""))
-      (widget-create 'link
-		     :notify (lambda (&rest ignore)
-			       (browse-url notmuch-hello-url))
-		     :help-echo "Visit the notmuch website."
-		     "notmuch")
-      (widget-insert ". ")
-      (widget-insert "You have ")
-      (widget-create 'link
-		     :notify (lambda (&rest ignore)
-			       (notmuch-hello-update))
-		     :help-echo "Refresh"
-		     (notmuch-hello-nice-number
-		      (string-to-number (car (process-lines notmuch-command "count")))))
-      (widget-insert " messages.\n"))
-
-    (let ((found-target-pos nil)
-	  (final-target-pos nil))
-      (let* ((saved-alist
-	      ;; Filter out empty saved seaches if required.
-	      (if notmuch-show-empty-saved-searches
-		  notmuch-saved-searches
-		(loop for elem in notmuch-saved-searches
-		      if (> (string-to-number (notmuch-saved-search-count (cdr elem))) 0)
-		      collect elem)))
-	     (saved-widest (notmuch-hello-longest-label saved-alist))
-	     (alltags-alist (if notmuch-show-all-tags-list
-				(mapcar '(lambda (tag) (cons tag (concat "tag:" tag)))
-					(process-lines notmuch-command "search-tags"))))
-	     (alltags-widest (notmuch-hello-longest-label alltags-alist))
-	     (widest (max saved-widest alltags-widest)))
-
-	(when saved-alist
-	  (widget-insert "\nSaved searches: ")
-	  (widget-create 'push-button
-			 :notify (lambda (&rest ignore)
-				   (customize-variable 'notmuch-saved-searches))
-			 "edit")
-	  (widget-insert "\n\n")
-	  (setq final-target-pos (point-marker))
-	  (let ((start (point)))
-	    (setq found-target-pos (notmuch-hello-insert-tags saved-alist widest target))
-	    (if found-target-pos
-		(setq final-target-pos found-target-pos))
-	    (indent-rigidly start (point) notmuch-hello-indent)))
-
-	(widget-insert "\nSearch: ")
-	(setq notmuch-hello-search-bar-marker (point-marker))
-	(widget-create 'editable-field
-		       ;; Leave some space at the start and end of the
-		       ;; search boxes.
-		       :size (max 8 (- (window-width) notmuch-hello-indent
-				       (length "Search: ")))
-		       :action (lambda (widget &rest ignore)
-				 (notmuch-hello-search (widget-value widget))))
-	(widget-insert "\n")
-
-	(when notmuch-hello-recent-searches
-	  (widget-insert "\nRecent searches: ")
-	  (widget-create 'push-button
-			 :notify (lambda (&rest ignore)
-				   (setq notmuch-hello-recent-searches nil)
-				   (notmuch-hello-update))
-			 "clear")
-	  (widget-insert "\n\n")
-	  (let ((start (point))
-		(nth 0))
-	    (mapc '(lambda (search)
-		     (let ((widget-symbol (intern (format "notmuch-hello-search-%d" nth))))
-		       (set widget-symbol
-			    (widget-create 'editable-field
-				       ;; Don't let the search boxes be
-				       ;; less than 8 characters wide.
-				       :size (max 8
-						  (- (window-width)
-						     ;; Leave some space
-						     ;; at the start and
-						     ;; end of the
-						     ;; boxes.
-						     (* 2 notmuch-hello-indent)
-						     ;; 1 for the space
-						     ;; before the
-						     ;; `[save]' button. 6
-						     ;; for the `[save]'
-						     ;; button.
-						     1 6))
-				       :action (lambda (widget &rest ignore)
-						 (notmuch-hello-search (widget-value widget)))
-				       search))
-		       (widget-insert " ")
-		       (widget-create 'push-button
-				      :notify (lambda (widget &rest ignore)
-						(notmuch-hello-add-saved-search widget))
-				      :notmuch-saved-search-widget widget-symbol
-				      "save"))
-		     (widget-insert "\n")
-		     (setq nth (1+ nth)))
-		  notmuch-hello-recent-searches)
-	    (indent-rigidly start (point) notmuch-hello-indent)))
-
-	(when alltags-alist
-	  (widget-insert "\nAll tags: ")
-	  (widget-create 'push-button
-			 :notify (lambda (widget &rest ignore)
-				   (setq notmuch-show-all-tags-list nil)
-				   (notmuch-hello-update))
-			 "hide")
-	  (widget-insert "\n\n")
-	  (let ((start (point)))
-	    (setq found-target-pos (notmuch-hello-insert-tags alltags-alist widest target))
-	    (if (not final-target-pos)
-		(setq final-target-pos found-target-pos))
-	    (indent-rigidly start (point) notmuch-hello-indent)))
-
-	(widget-insert "\n")
-
-	(if (not notmuch-show-all-tags-list)
+  ;; Generate the string version of all queries listed in
+  ;; `notmuch-saved-searches'. We do this here at the start so that
+  ;; the rest of the routine has a stable set to work from.
+  (let ((saved-searches (notmuch-hello-generate-saved-searches notmuch-saved-searches)))
+
+    (if no-display
+	(set-buffer "*notmuch-hello*")
+      (switch-to-buffer "*notmuch-hello*"))
+
+    (let ((target (if (widget-at)
+		      (widget-value (widget-at))
+		    (condition-case nil
+			(progn
+			  (widget-forward 1)
+			  (widget-value (widget-at)))
+		      (error nil)))))
+
+      (kill-all-local-variables)
+      (let ((inhibit-read-only t))
+	(erase-buffer))
+
+      (unless (eq major-mode 'notmuch-hello-mode)
+	(notmuch-hello-mode))
+
+      (let ((all (overlay-lists)))
+	;; Delete all the overlays.
+	(mapc 'delete-overlay (car all))
+	(mapc 'delete-overlay (cdr all)))
+
+      (when notmuch-show-logo
+	(let ((image notmuch-hello-logo))
+	  ;; The notmuch logo uses transparency. That can display poorly
+	  ;; when inserting the image into an emacs buffer (black logo on
+	  ;; a black background), so force the background colour of the
+	  ;; image. We use a face to represent the colour so that
+	  ;; `defface' can be used to declare the different possible
+	  ;; colours, which depend on whether the frame has a light or
+	  ;; dark background.
+	  (setq image (cons 'image
+			    (append (cdr image)
+				    (list :background (face-background 'notmuch-hello-logo-background)))))
+	  (insert-image image))
+	(widget-insert "  "))
+
+      (widget-insert "Welcome to ")
+      ;; Hack the display of the links used.
+      (let ((widget-link-prefix "")
+	    (widget-link-suffix ""))
+	(widget-create 'link
+		       :notify (lambda (&rest ignore)
+				 (browse-url notmuch-hello-url))
+		       :help-echo "Visit the notmuch website."
+		       "notmuch")
+	(widget-insert ". ")
+	(widget-insert "You have ")
+	(widget-create 'link
+		       :notify (lambda (&rest ignore)
+				 (notmuch-hello-update))
+		       :help-echo "Refresh"
+		       (notmuch-hello-nice-number
+			(string-to-number (car (process-lines notmuch-command "count")))))
+	(widget-insert " messages.\n"))
+
+      (let ((found-target-pos nil)
+	    (final-target-pos nil))
+	(let* ((saved-alist
+		;; Filter out empty saved seaches if required.
+		(if notmuch-show-empty-saved-searches
+		    saved-searches
+		  (loop for elem in saved-searches
+			if (> (string-to-number (notmuch-saved-search-count (cdr elem))) 0)
+			collect elem)))
+	       (saved-widest (notmuch-hello-longest-label saved-alist))
+	       (alltags-alist (if notmuch-show-all-tags-list
+				  (mapcar '(lambda (tag) (cons tag (concat "tag:" tag)))
+					  (process-lines notmuch-command "search-tags"))))
+	       (alltags-widest (notmuch-hello-longest-label alltags-alist))
+	       (widest (max saved-widest alltags-widest)))
+
+	  (when saved-alist
+	    (widget-insert "\nSaved searches: ")
+	    (widget-create 'push-button
+			   :notify (lambda (&rest ignore)
+				     (customize-variable 'notmuch-saved-searches))
+			   "edit")
+	    (widget-insert "\n\n")
+	    (setq final-target-pos (point-marker))
+	    (let ((start (point)))
+	      (setq found-target-pos (notmuch-hello-insert-tags saved-alist widest target))
+	      (if found-target-pos
+		  (setq final-target-pos found-target-pos))
+	      (indent-rigidly start (point) notmuch-hello-indent)))
+
+	  (widget-insert "\nSearch: ")
+	  (setq notmuch-hello-search-bar-marker (point-marker))
+	  (widget-create 'editable-field
+			 ;; Leave some space at the start and end of the
+			 ;; search boxes.
+			 :size (max 8 (- (window-width) notmuch-hello-indent
+					 (length "Search: ")))
+			 :action (lambda (widget &rest ignore)
+				   (notmuch-hello-search (widget-value widget))))
+	  (widget-insert "\n")
+
+	  (when notmuch-hello-recent-searches
+	    (widget-insert "\nRecent searches: ")
+	    (widget-create 'push-button
+			   :notify (lambda (&rest ignore)
+				     (setq notmuch-hello-recent-searches nil)
+				     (notmuch-hello-update))
+			   "clear")
+	    (widget-insert "\n\n")
+	    (let ((start (point))
+		  (nth 0))
+	      (mapc '(lambda (search)
+		       (let ((widget-symbol (intern (format "notmuch-hello-search-%d" nth))))
+			 (set widget-symbol
+			      (widget-create 'editable-field
+					     ;; Don't let the search boxes be
+					     ;; less than 8 characters wide.
+					     :size (max 8
+							(- (window-width)
+							   ;; Leave some space
+							   ;; at the start and
+							   ;; end of the
+							   ;; boxes.
+							   (* 2 notmuch-hello-indent)
+							   ;; 1 for the space
+							   ;; before the
+							   ;; `[save]' button. 6
+							   ;; for the `[save]'
+							   ;; button.
+							   1 6))
+					     :action (lambda (widget &rest ignore)
+						       (notmuch-hello-search (widget-value widget)))
+					     search))
+			 (widget-insert " ")
+			 (widget-create 'push-button
+					:notify (lambda (widget &rest ignore)
+						  (notmuch-hello-add-saved-search widget))
+					:notmuch-saved-search-widget widget-symbol
+					"save"))
+		       (widget-insert "\n")
+		       (setq nth (1+ nth)))
+		    notmuch-hello-recent-searches)
+	      (indent-rigidly start (point) notmuch-hello-indent)))
+
+	  (when alltags-alist
+	    (widget-insert "\nAll tags: ")
 	    (widget-create 'push-button
 			   :notify (lambda (widget &rest ignore)
-				     (setq notmuch-show-all-tags-list t)
+				     (setq notmuch-show-all-tags-list nil)
 				     (notmuch-hello-update))
-			   "Show all tags")))
-
-      (let ((start (point)))
-	(widget-insert "\n\n")
-	(widget-insert "Type a search query and hit RET to view matching threads.\n")
-	(when notmuch-hello-recent-searches
-	  (widget-insert "Hit RET to re-submit a previous search. Edit it first if you like.\n")
-	  (widget-insert "Save recent searches with the `save' button.\n"))
-	(when notmuch-saved-searches
-	  (widget-insert "Edit saved searches with the `edit' button.\n"))
-	(widget-insert "Hit RET or click on a saved search or tag name to view matching threads.\n")
-	(widget-insert "`=' refreshes this screen. `s' jumps to the search box. `q' to quit.\n")
-	(let ((fill-column (- (window-width) notmuch-hello-indent)))
-	  (center-region start (point))))
-
-      (widget-setup)
-
-      (when final-target-pos
-	(goto-char final-target-pos)
-	(unless (widget-at)
-	  (widget-forward 1)))
+			   "hide")
+	    (widget-insert "\n\n")
+	    (let ((start (point)))
+	      (setq found-target-pos (notmuch-hello-insert-tags alltags-alist widest target))
+	      (if (not final-target-pos)
+		  (setq final-target-pos found-target-pos))
+	      (indent-rigidly start (point) notmuch-hello-indent)))
+
+	  (widget-insert "\n")
+
+	  (if (not notmuch-show-all-tags-list)
+	      (widget-create 'push-button
+			     :notify (lambda (widget &rest ignore)
+				       (setq notmuch-show-all-tags-list t)
+				       (notmuch-hello-update))
+			     "Show all tags")))
+
+	(let ((start (point)))
+	  (widget-insert "\n\n")
+	  (widget-insert "Type a search query and hit RET to view matching threads.\n")
+	  (when notmuch-hello-recent-searches
+	    (widget-insert "Hit RET to re-submit a previous search. Edit it first if you like.\n")
+	    (widget-insert "Save recent searches with the `save' button.\n"))
+	  (when notmuch-saved-searches
+	    (widget-insert "Edit saved searches with the `edit' button.\n"))
+	  (widget-insert "Hit RET or click on a saved search or tag name to view matching threads.\n")
+	  (widget-insert "`=' refreshes this screen. `s' jumps to the search box. `q' to quit.\n")
+	  (let ((fill-column (- (window-width) notmuch-hello-indent)))
+	    (center-region start (point))))
+
+	(widget-setup)
+
+	(when final-target-pos
+	  (goto-char final-target-pos)
+	  (unless (widget-at)
+	    (widget-forward 1)))
 
-      (unless (widget-at)
-	(notmuch-hello-goto-search)))))
+	(unless (widget-at)
+	  (notmuch-hello-goto-search))))))
 
 (defun notmuch-folder ()
   "Deprecated function for invoking notmuch---calling `notmuch' is preferred now."
diff --git a/emacs/notmuch-lib.el b/emacs/notmuch-lib.el
index 9d4e00f..9712f01 100644
--- a/emacs/notmuch-lib.el
+++ b/emacs/notmuch-lib.el
@@ -37,7 +37,9 @@
 
 (defcustom notmuch-saved-searches nil
   "A list of saved searches to display."
-  :type '(alist :key-type string :value-type string)
+  :type '(alist :key-type (string :tag "Name")
+		:value-type (choice (string :tag "Search")
+				    (function :tag "Function")))
   :group 'notmuch)
 
 (defvar notmuch-folders nil
diff --git a/emacs/notmuch.el b/emacs/notmuch.el
index b003cd6..e8d4d98 100644
--- a/emacs/notmuch.el
+++ b/emacs/notmuch.el
@@ -808,10 +808,11 @@ characters as well as `_.+-'.
 	  (let (longest
 		(longest-length 0))
 	    (loop for tuple in notmuch-saved-searches
-		  if (let ((quoted-query (regexp-quote (cdr tuple))))
-		       (and (string-match (concat "^" quoted-query) query)
-			    (> (length (match-string 0 query))
-			       longest-length)))
+		  if (and (stringp (cdr tuple))
+			  (let ((quoted-query (regexp-quote (cdr tuple))))
+			    (and (string-match (concat "^" quoted-query) query)
+				 (> (length (match-string 0 query))
+				    longest-length))))
 		  do (setq longest tuple))
 	    longest))
 	 (saved-search-name (car saved-search))
-- 
1.7.2.3



More information about the notmuch mailing list