>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