mirror of
https://git.notmuchmail.org/git/notmuch
synced 2024-12-22 09:24:54 +01:00
emacs: Add notmuch-hello.el, a friendly frontend to notmuch
This is based on the prototype that Carl Worth described in the TODO file. It provides a search bar as well as support for recent searches, saved searches, and a list of all tags in the database (as well as the number of messages with each tag).
This commit is contained in:
David Edmondson
Carl Worth
parent
b65bcb5f8f
commit
e9394932f7
5 changed files with 391 additions and 12 deletions
|
|
@ -6,7 +6,11 @@ emacs_sources := \
|
|||
$(dir)/notmuch.el \
|
||||
$(dir)/notmuch-query.el \
|
||||
$(dir)/notmuch-show.el \
|
||||
$(dir)/notmuch-wash.el
|
||||
$(dir)/notmuch-wash.el \
|
||||
$(dir)/notmuch-hello.el
|
||||
|
||||
emacs_images := \
|
||||
$(dir)/notmuch-logo.png
|
||||
|
||||
emacs_bytecode := $(subst .el,.elc,$(emacs_sources))
|
||||
|
||||
|
|
@ -26,5 +30,6 @@ install-emacs:
|
|||
ifeq ($(HAVE_EMACS),1)
|
||||
install -m0644 $(emacs_bytecode) $(DESTDIR)$(emacslispdir)
|
||||
endif
|
||||
install -m0644 $(emacs_images) $(DESTDIR)$(emacslispdir)
|
||||
|
||||
CLEAN := $(CLEAN) $(emacs_bytecode)
|
||||
|
|
|
|||
359
emacs/notmuch-hello.el
Normal file
359
emacs/notmuch-hello.el
Normal file
|
|
@ -0,0 +1,359 @@
|
|||
;; notmuch-hello.el --- welcome to notmuch, a frontend
|
||||
;;
|
||||
;; Copyright © David Edmondson
|
||||
;;
|
||||
;; This file is part of Notmuch.
|
||||
;;
|
||||
;; Notmuch is free software: you can redistribute it and/or modify it
|
||||
;; under the terms of the GNU General Public License as published by
|
||||
;; the Free Software Foundation, either version 3 of the License, or
|
||||
;; (at your option) any later version.
|
||||
;;
|
||||
;; Notmuch is distributed in the hope that it will be useful, but
|
||||
;; WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
||||
;; General Public License for more details.
|
||||
;;
|
||||
;; You should have received a copy of the GNU General Public License
|
||||
;; along with Notmuch. If not, see <http://www.gnu.org/licenses/>.
|
||||
;;
|
||||
;; Authors: David Edmondson <dme@dme.org>
|
||||
|
||||
(require 'widget)
|
||||
(require 'wid-edit) ; For `widget-forward'.
|
||||
(require 'cl)
|
||||
|
||||
(require 'notmuch-lib)
|
||||
(require 'notmuch)
|
||||
|
||||
(declare-function notmuch-search "notmuch" (query &optional oldest-first target-thread target-line))
|
||||
(declare-function notmuch-folder-count "notmuch" (search))
|
||||
|
||||
(defcustom notmuch-hello-recent-searches-max 10
|
||||
"The number of recent searches to store and display."
|
||||
:type 'integer
|
||||
:group 'notmuch)
|
||||
|
||||
(defcustom notmuch-hello-show-empty-saved-searches nil
|
||||
"Should saved searches with no messages be listed?"
|
||||
:type 'boolean
|
||||
:group 'notmuch)
|
||||
|
||||
(defcustom notmuch-hello-indent 4
|
||||
"How much to indent non-headers."
|
||||
:type 'integer
|
||||
:group 'notmuch)
|
||||
|
||||
(defcustom notmuch-hello-saved-searches notmuch-folders
|
||||
"A list of saved searches to display."
|
||||
:type '(alist :key-type string :value-type string)
|
||||
:group 'notmuch)
|
||||
|
||||
(defcustom notmuch-hello-show-logo t
|
||||
"Should the notmuch logo be shown?"
|
||||
:type 'boolean
|
||||
:group 'notmuch)
|
||||
|
||||
(defcustom notmuch-hello-logo-background "#5f5f5f"
|
||||
"Background colour for the notmuch logo."
|
||||
:type 'color
|
||||
:group 'notmuch)
|
||||
|
||||
(defcustom notmuch-hello-jump-to-search nil
|
||||
"Whether `notmuch-hello' should always jump to the search
|
||||
field."
|
||||
:type 'boolean
|
||||
:group 'notmuch)
|
||||
|
||||
(defvar notmuch-hello-url "http://notmuchmail.org"
|
||||
"The `notmuch' web site.")
|
||||
|
||||
(defvar notmuch-hello-recent-searches nil)
|
||||
|
||||
(defun notmuch-hello-remember-search (search)
|
||||
(if (not (memq search notmuch-hello-recent-searches))
|
||||
(push search notmuch-hello-recent-searches))
|
||||
(if (> (length notmuch-hello-recent-searches)
|
||||
notmuch-hello-recent-searches-max)
|
||||
(setq notmuch-hello-recent-searches (butlast notmuch-hello-recent-searches))))
|
||||
|
||||
(defun notmuch-hello-trim (search)
|
||||
"Trim whitespace."
|
||||
(if (string-match "^[[:space:]]*\\(.*[^[:space:]]\\)[[:space:]]*$" search)
|
||||
(match-string 1 search)
|
||||
search))
|
||||
|
||||
(defun notmuch-hello-search (search)
|
||||
(let ((search (notmuch-hello-trim search)))
|
||||
(notmuch-hello-remember-search search)
|
||||
(notmuch-search search notmuch-search-oldest-first nil nil #'notmuch-hello-search-continuation)))
|
||||
|
||||
(defun notmuch-hello-add-saved-search (widget)
|
||||
(interactive)
|
||||
(let ((search (widget-value
|
||||
(symbol-value
|
||||
(widget-get widget :notmuch-saved-search-widget))))
|
||||
(name (completing-read "Name for saved search: "
|
||||
notmuch-hello-saved-searches)))
|
||||
;; If an existing saved search with this name exists, remove it.
|
||||
(setq notmuch-hello-saved-searches
|
||||
(loop for elem in notmuch-hello-saved-searches
|
||||
if (not (equal name
|
||||
(car elem)))
|
||||
collect elem))
|
||||
;; Add the new one.
|
||||
(customize-save-variable 'notmuch-hello-saved-searches
|
||||
(push (cons name search)
|
||||
notmuch-hello-saved-searches))
|
||||
(message "Saved '%s' as '%s'." search name)
|
||||
(notmuch-hello-update)))
|
||||
|
||||
(defun notmuch-hello-longest-label (tag-alist)
|
||||
(or (loop for elem in tag-alist
|
||||
maximize (length (car elem)))
|
||||
0))
|
||||
|
||||
(defun notmuch-hello-roundup (dividend divisor)
|
||||
"Return the rounded up value of dividing `dividend' by `divisor'."
|
||||
(+ (/ dividend divisor)
|
||||
(if (> (% dividend divisor) 0) 1 0)))
|
||||
|
||||
(defun notmuch-hello-reflect (list width)
|
||||
"Reflect a `width' wide matrix represented by `list' along the
|
||||
diagonal."
|
||||
;; Not very lispy...
|
||||
(let* ((len (length list))
|
||||
(nrows (notmuch-hello-roundup len width)))
|
||||
(loop for row from 0 to (- nrows 1)
|
||||
append (loop for col from 0 to (- width 1)
|
||||
;; How could we calculate the offset just once
|
||||
;; per inner-loop?
|
||||
if (< (+ (* nrows col) row) len)
|
||||
collect (nth (+ (* nrows col) row) list)
|
||||
else
|
||||
;; Don't forget to insert an empty slot in the
|
||||
;; output matrix if there is no corresponding
|
||||
;; value in the input matrix.
|
||||
collect nil))))
|
||||
|
||||
(defun notmuch-hello-widget-search (widget &rest ignore)
|
||||
(notmuch-search (widget-get widget
|
||||
:notmuch-search-terms)
|
||||
notmuch-search-oldest-first
|
||||
nil nil #'notmuch-hello-search-continuation))
|
||||
|
||||
(defun notmuch-hello-insert-tags (tag-alist widest)
|
||||
(let* ((tag-format-string (format "%%-%ds " widest))
|
||||
(tags-per-line (max 1
|
||||
(/ (- (window-width) notmuch-hello-indent)
|
||||
;; Count is 7 wide, 1 for the space
|
||||
;; after the name.
|
||||
(+ 7 1 widest))))
|
||||
(count 0)
|
||||
(reordered-list (notmuch-hello-reflect tag-alist tags-per-line))
|
||||
;; Hack the display of the buttons used.
|
||||
(widget-push-button-prefix "")
|
||||
(widget-push-button-suffix ""))
|
||||
;; dme: It feels as though there should be a better way to
|
||||
;; implement this loop than using an incrementing counter.
|
||||
(loop for elem in reordered-list
|
||||
do (progn
|
||||
;; (not elem) indicates an empty slot in the matrix.
|
||||
(when elem
|
||||
(widget-insert (format "%6s " (notmuch-folder-count (cdr elem))))
|
||||
(widget-create 'push-button
|
||||
:notify #'notmuch-hello-widget-search
|
||||
:notmuch-search-terms (cdr elem)
|
||||
(format tag-format-string (car elem))))
|
||||
(setq count (1+ count))
|
||||
(if (eq (% count tags-per-line) 0)
|
||||
(widget-insert "\n"))))
|
||||
|
||||
;; If the last line was not full (and hence did not include a
|
||||
;; carriage return), insert one now.
|
||||
(if (not (eq (% count tags-per-line) 0))
|
||||
(widget-insert "\n"))))
|
||||
|
||||
(defun notmuch-hello-goto-search ()
|
||||
"Put point inside the `search' widget, which we know is first."
|
||||
(interactive)
|
||||
(goto-char (point-min))
|
||||
(widget-forward 3))
|
||||
|
||||
(defimage notmuch-hello-logo ((:type png :file "notmuch-logo.png")))
|
||||
|
||||
(defun notmuch-hello-search-continuation()
|
||||
(notmuch-hello t))
|
||||
|
||||
(defun notmuch-hello-update (&optional no-display)
|
||||
;; Lazy - rebuild everything.
|
||||
(interactive)
|
||||
(notmuch-hello no-display))
|
||||
|
||||
(defun notmuch-hello (&optional no-display)
|
||||
(interactive)
|
||||
|
||||
(if no-display
|
||||
(set-buffer "*notmuch-hello*")
|
||||
(switch-to-buffer "*notmuch-hello*"))
|
||||
|
||||
(kill-all-local-variables)
|
||||
(let ((inhibit-read-only t))
|
||||
(erase-buffer))
|
||||
|
||||
(let ((all (overlay-lists)))
|
||||
;; Delete all the overlays.
|
||||
(mapc 'delete-overlay (car all))
|
||||
(mapc 'delete-overlay (cdr all)))
|
||||
|
||||
(when notmuch-hello-show-logo
|
||||
(let ((image notmuch-hello-logo))
|
||||
;; dme: Sorry, I don't know any other way to achieve this :-( The
|
||||
;; notmuch logo uses transparency. That works out badly when
|
||||
;; inserting the image into an emacs buffer, so force the
|
||||
;; background colour of the image.
|
||||
(setq image (cons 'image (append (cdr image)
|
||||
`(: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"
|
||||
(car (process-lines notmuch-command "count")))
|
||||
(widget-insert " messages (that's not much mail).\n\n"))
|
||||
|
||||
(let ((start (point)))
|
||||
(widget-insert "Search: ")
|
||||
(widget-create 'editable-field
|
||||
;; Leave some space at the start and end of the
|
||||
;; search boxes.
|
||||
:size (max 8 (- (window-width) (* 2 notmuch-hello-indent)
|
||||
(length "Search: ")))
|
||||
:action (lambda (widget &rest ignore)
|
||||
(notmuch-hello-search (widget-value widget))))
|
||||
(widget-insert "\n")
|
||||
(indent-rigidly start (point) notmuch-hello-indent))
|
||||
|
||||
(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))
|
||||
(key 0))
|
||||
(mapc '(lambda (search)
|
||||
(widget-insert (format "%2d: " key))
|
||||
(let ((widget-symbol (intern (format "notmuch-hello-search-%d" key))))
|
||||
(set widget-symbol
|
||||
(widget-create 'editable-field
|
||||
;; Leave some space at the start
|
||||
;; and end of the search boxes. 4
|
||||
;; for the accelerator key. 1 for
|
||||
;; the space before the `save'
|
||||
;; button. 6 for the `save'
|
||||
;; button.
|
||||
:size (max 8 (- (window-width) (* 2 notmuch-hello-indent)
|
||||
4 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 key (1+ key)))
|
||||
notmuch-hello-recent-searches)
|
||||
(indent-rigidly start (point) notmuch-hello-indent)))
|
||||
|
||||
(let* ((saved-alist
|
||||
;; Filter out empty saved seaches if required.
|
||||
(if notmuch-hello-show-empty-saved-searches
|
||||
notmuch-hello-saved-searches
|
||||
(loop for elem in notmuch-hello-saved-searches
|
||||
if (> (string-to-number (notmuch-folder-count (cdr elem))) 0)
|
||||
collect elem)))
|
||||
(saved-widest (notmuch-hello-longest-label saved-alist))
|
||||
(alltags-alist (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-hello-saved-searches))
|
||||
"edit")
|
||||
(widget-insert "\n\n")
|
||||
(let ((start (point)))
|
||||
(notmuch-hello-insert-tags saved-alist widest)
|
||||
(indent-rigidly start (point) notmuch-hello-indent)))
|
||||
|
||||
(when alltags-alist
|
||||
(widget-insert "\nAll tags:\n\n")
|
||||
(let ((start (point)))
|
||||
(notmuch-hello-insert-tags alltags-alist widest)
|
||||
(indent-rigidly start (point) notmuch-hello-indent))))
|
||||
|
||||
(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")
|
||||
(let ((searches (length notmuch-hello-recent-searches)))
|
||||
(widget-insert
|
||||
(if (eq 1 searches)
|
||||
"Key 0 acts as an accelerator for the previous query.\n"
|
||||
(format "Keys 0-%d act as accelerators for the previous queries.\n"
|
||||
(- searches 1)))))
|
||||
(widget-insert "Save recent searches with the `save' button.\n"))
|
||||
(when notmuch-hello-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))))
|
||||
|
||||
(use-local-map widget-keymap)
|
||||
(local-set-key "=" 'notmuch-hello-update)
|
||||
(local-set-key "q" '(lambda () (interactive) (kill-buffer (current-buffer))))
|
||||
(local-set-key "s" 'notmuch-hello-goto-search)
|
||||
(local-set-key "v" '(lambda () (interactive)
|
||||
(message "notmuch version %s" (notmuch-version))))
|
||||
|
||||
(loop for key from 0 to (- (length notmuch-hello-recent-searches) 1)
|
||||
do (let ((widget-symbol (intern (format "notmuch-hello-search-%d" key))))
|
||||
(local-set-key (number-to-string key)
|
||||
`(lambda ()
|
||||
(interactive)
|
||||
(notmuch-search (widget-value ,widget-symbol)
|
||||
notmuch-search-oldest-first
|
||||
nil nil #'notmuch-hello-search-continuation)))))
|
||||
(widget-setup)
|
||||
|
||||
(if notmuch-hello-jump-to-search
|
||||
(notmuch-hello-goto-search)
|
||||
(goto-char (point-min))))
|
||||
|
||||
;;
|
||||
|
||||
(provide 'notmuch-hello)
|
||||
|
|
@ -24,6 +24,15 @@
|
|||
(defvar notmuch-command "notmuch"
|
||||
"Command to run the notmuch binary.")
|
||||
|
||||
(defgroup notmuch nil
|
||||
"Notmuch mail reader for Emacs."
|
||||
:group 'mail)
|
||||
|
||||
(defcustom notmuch-folders '(("inbox" . "tag:inbox") ("unread" . "tag:unread"))
|
||||
"List of searches for the notmuch folder view"
|
||||
:type '(alist :key-type (string) :value-type (string))
|
||||
:group 'notmuch)
|
||||
|
||||
;; XXX: This should be a generic function in emacs somewhere, not
|
||||
;; here.
|
||||
(defun point-invisible-p ()
|
||||
|
|
|
|||
BIN
emacs/notmuch-logo.png
Normal file
BIN
emacs/notmuch-logo.png
Normal file
Binary file not shown.
|
After Width: | Height: | Size: 1.6 KiB |
|
|
@ -192,10 +192,6 @@ For a mouse binding, return nil."
|
|||
(set-buffer-modified-p nil)
|
||||
(view-buffer (current-buffer) 'kill-buffer-if-not-modified))))
|
||||
|
||||
(defgroup notmuch nil
|
||||
"Notmuch mail reader for Emacs."
|
||||
:group 'mail)
|
||||
|
||||
(defcustom notmuch-search-hook '(hl-line-mode)
|
||||
"List of functions to call when notmuch displays the search results."
|
||||
:type 'hook
|
||||
|
|
@ -205,8 +201,8 @@ For a mouse binding, return nil."
|
|||
(defvar notmuch-search-mode-map
|
||||
(let ((map (make-sparse-keymap)))
|
||||
(define-key map "?" 'notmuch-help)
|
||||
(define-key map "q" 'kill-this-buffer)
|
||||
(define-key map "x" 'kill-this-buffer)
|
||||
(define-key map "q" 'notmuch-search-quit)
|
||||
(define-key map "x" 'notmuch-search-quit)
|
||||
(define-key map (kbd "<DEL>") 'notmuch-search-scroll-down)
|
||||
(define-key map "b" 'notmuch-search-scroll-down)
|
||||
(define-key map " " 'notmuch-search-scroll-up)
|
||||
|
|
@ -240,6 +236,14 @@ For a mouse binding, return nil."
|
|||
|
||||
(defvar notmuch-search-disjunctive-regexp "\\<[oO][rR]\\>")
|
||||
|
||||
(defun notmuch-search-quit ()
|
||||
"Exit the search buffer, calling any defined continuation function."
|
||||
(interactive)
|
||||
(let ((continuation notmuch-search-continuation))
|
||||
(kill-this-buffer)
|
||||
(when continuation
|
||||
(funcall continuation))))
|
||||
|
||||
(defun notmuch-search-scroll-up ()
|
||||
"Move forward through search results by one window's worth."
|
||||
(interactive)
|
||||
|
|
@ -332,6 +336,7 @@ Complete list of currently available key bindings:
|
|||
(make-local-variable 'notmuch-search-oldest-first)
|
||||
(make-local-variable 'notmuch-search-target-thread)
|
||||
(make-local-variable 'notmuch-search-target-line)
|
||||
(set (make-local-variable 'notmuch-search-continuation) nil)
|
||||
(set (make-local-variable 'scroll-preserve-screen-position) t)
|
||||
(add-to-invisibility-spec 'notmuch-search)
|
||||
(use-local-map notmuch-search-mode-map)
|
||||
|
|
@ -689,7 +694,7 @@ characters as well as `_.+-'.
|
|||
)))
|
||||
|
||||
;;;###autoload
|
||||
(defun notmuch-search (query &optional oldest-first target-thread target-line)
|
||||
(defun notmuch-search (query &optional oldest-first target-thread target-line continuation)
|
||||
"Run \"notmuch search\" with the given query string and display results.
|
||||
|
||||
The optional parameters are used as follows:
|
||||
|
|
@ -707,6 +712,7 @@ The optional parameters are used as follows:
|
|||
(set 'notmuch-search-oldest-first oldest-first)
|
||||
(set 'notmuch-search-target-thread target-thread)
|
||||
(set 'notmuch-search-target-line target-line)
|
||||
(set 'notmuch-search-continuation continuation)
|
||||
(let ((proc (get-buffer-process (current-buffer)))
|
||||
(inhibit-read-only t))
|
||||
(if proc
|
||||
|
|
@ -735,11 +741,11 @@ same relative position within the new buffer."
|
|||
(let ((target-line (line-number-at-pos))
|
||||
(oldest-first notmuch-search-oldest-first)
|
||||
(target-thread (notmuch-search-find-thread-id))
|
||||
(query notmuch-search-query-string))
|
||||
(query notmuch-search-query-string)
|
||||
(continuation notmuch-search-continuation))
|
||||
(kill-this-buffer)
|
||||
(notmuch-search query oldest-first target-thread target-line)
|
||||
(goto-char (point-min))
|
||||
))
|
||||
(notmuch-search query oldest-first target-thread target-line continuation)
|
||||
(goto-char (point-min))))
|
||||
|
||||
(defcustom notmuch-poll-script ""
|
||||
"An external script to incorporate new mail into the notmuch database.
|
||||
|
|
|
|||
Loading…
Reference in a new issue