Return-Path: X-Original-To: notmuch@notmuchmail.org Delivered-To: notmuch@notmuchmail.org Received: from localhost (localhost [127.0.0.1]) by olra.theworths.org (Postfix) with ESMTP id 585954196F2 for ; Thu, 22 Apr 2010 01:27:46 -0700 (PDT) X-Virus-Scanned: Debian amavisd-new at olra.theworths.org X-Spam-Flag: NO X-Spam-Score: -1.9 X-Spam-Level: X-Spam-Status: No, score=-1.9 tagged_above=-999 required=5 tests=[BAYES_00=-1.9] autolearn=ham Received: from olra.theworths.org ([127.0.0.1]) by localhost (olra.theworths.org [127.0.0.1]) (amavisd-new, port 10024) with ESMTP id N9qF66scn+sv for ; Thu, 22 Apr 2010 01:27:43 -0700 (PDT) Received: from mail-wy0-f181.google.com (mail-wy0-f181.google.com [74.125.82.181]) by olra.theworths.org (Postfix) with ESMTP id 3FA4C431FC1 for ; Thu, 22 Apr 2010 01:27:43 -0700 (PDT) Received: by wyf23 with SMTP id 23so521890wyf.26 for ; Thu, 22 Apr 2010 01:27:42 -0700 (PDT) Received: by 10.216.154.7 with SMTP id g7mr5390790wek.7.1271924862234; Thu, 22 Apr 2010 01:27:42 -0700 (PDT) Received: from ut.hh.sledj.net (host83-217-165-81.dsl.vispa.com [83.217.165.81]) by mx.google.com with ESMTPS id r29sm73885746wbv.9.2010.04.22.01.27.39 (version=TLSv1/SSLv3 cipher=RC4-MD5); Thu, 22 Apr 2010 01:27:40 -0700 (PDT) Received: by ut.hh.sledj.net (Postfix, from userid 1000) id B3B3CD66001; Thu, 22 Apr 2010 09:27:36 +0100 (BST) From: David Edmondson To: notmuch@notmuchmail.org Subject: [PATCH] emacs: Add notmuch-hello.el, a friendly frontend to notmuch Date: Thu, 22 Apr 2010 09:27:33 +0100 Message-Id: <1271924853-8183-1-git-send-email-dme@dme.org> X-Mailer: git-send-email 1.7.0 In-Reply-To: <87y6gguw99.fsf@yoom.home.cworth.org> References: <87y6gguw99.fsf@yoom.home.cworth.org> X-BeenThere: notmuch@notmuchmail.org X-Mailman-Version: 2.1.13 Precedence: list List-Id: "Use and development of the notmuch mail system." List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , X-List-Received-Date: Thu, 22 Apr 2010 08:27:46 -0000 --- emacs/Makefile.local | 5 + emacs/notmuch-hello.el | 359 ++++++++++++++++++++++++++++++++++++++++++++++++ emacs/notmuch-lib.el | 9 ++ emacs/notmuch-logo.png | Bin 0 -> 1671 bytes emacs/notmuch.el | 28 +++-- 5 files changed, 390 insertions(+), 11 deletions(-) create mode 100644 emacs/notmuch-hello.el create mode 100644 emacs/notmuch-logo.png diff --git a/emacs/Makefile.local b/emacs/Makefile.local index f759c0d..6486d90 100644 --- a/emacs/Makefile.local +++ b/emacs/Makefile.local @@ -7,6 +7,10 @@ emacs_sources := \ $(dir)/notmuch-query.el \ $(dir)/notmuch-show.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) diff --git a/emacs/notmuch-hello.el b/emacs/notmuch-hello.el new file mode 100644 index 0000000..13de6f8 --- /dev/null +++ b/emacs/notmuch-hello.el @@ -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 . +;; +;; Authors: David Edmondson + +(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) diff --git a/emacs/notmuch-lib.el b/emacs/notmuch-lib.el index cb9be30..274d7ec 100644 --- a/emacs/notmuch-lib.el +++ b/emacs/notmuch-lib.el @@ -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 () diff --git a/emacs/notmuch-logo.png b/emacs/notmuch-logo.png new file mode 100644 index 0000000000000000000000000000000000000000..53b5e6a40674c574f131f7f66afc52485b65836c GIT binary patch literal 1671 zcmV;226*|2P)400006VoOIv0RI60 z0RN!9r;`8x20TebK~!jg?V4Lm990;{f4jAIda0$gyH@L3w?qwA+IXRj zh8k-lC8VO%;3d&0Rxu_9wGWNaQXgn0s;CuFOj~x3 z4`&8umt|*WXIWC~FFDz{d}q%2@40>Roq@3Ks_)kM$fg(VxS+$ z0Uicc0hd{L-W`C@qz9~4&?x8W-0uL=00&SDJOZo+T);)Z55RZ8x4;Pl<^3LV{;QeF z#)F4|y}(?}wOPRJz?;A!;5hIRP=;*zODB0&0rC$lnWDN{VmojXP!z#tK2Qp@0H=^$ zvk&+XcmcSJ@jvS2DXXakoIr(gTxl>*60jDi1_lTompwo?P>8kh9&^?MUgh{z;1ZMh z?ZA!5R{RDCFfKZP9N*=NjXehSjhgM63b=ty7N3`aoXKAYJ_r6_T=)rOFIbE06>&q` zZB=$yeCEZ#G0nLRxEfdoyn&qbhLGd@Q{=dxZ?R0><>fx$nQKzJ&qyq*j>{aZ~HzhMX>wsM3gjN;N(q^*- z3JVK`+wB%@ZEZqj=gys?wY61*qpYk<3=9kiA%xhoXOCF4Xptx`E>;EWv0AY+J9~%Y zJ>Y5NGBrofSO_6RdwaWZyWOI&uuu#R4vM0pBH{P@!wTKMf4?X%FBfaptP$DS*}~`Z z2_b}0p${r{RwtMwU@LkpsbNgO=;)}}wr!ip%*+%kSFQ{zbYx^iY}v9!IGs*WTU#pv zfxy^3j0xSO*tw(AH^w^PHsCoRQ_nbPfu1pA1|=mWY~H*XfaS}V^)gIwxlW!uNpf;B?d|QPrl#Wa z`It9v9;KzFw6wI)+uKW5R~K1XS#)%CL{rIFwCFv^^;D$?9kCNyw5h3yw6rvAHXAuP zIRKQGmyg}g&(Ej1xtXD%Au=*D=D=9gd@br*G)`JJZPY@{fd2)0ozd4BU^Mbok}y2oR2W!1Lj5*ntm#Y~cGS3RXD++==v5B4Gy-m1DDA*U9AFR;336?w}1BzI+Gh z0?rV*1%E=WUu)5Sfmcb^A zSfn?YT;LTT9qCP(X;F~t^%KBv$gPmL@)E&o@hTnrCmG+Fi#8o3q#MVBts#}jH;^Y2 z>BJ0TPT*nWA9Vptf7dlKMt=kz1s+H4xGhF59dnVhb^`L7h(D2$`cC97e5dvy(=F6Y zfXokktt8XLd)5sVW;Nt#n6qJdi3$G;og&T|p`i}Ke^%%@(V}yhxWk?t$MWOGi%j%h z0?1g?lw*3&&mgmqZ~2+X@Z&0^lOB#U$N=45hD17%A9mCuw;ZO8ROCldF$sW2NCD*cP1EvyuO0a{$W)8ernjQ4?7w==f>M#W RS^fY3002ovPDHLkV1lYt4A1}o literal 0 HcmV?d00001 diff --git a/emacs/notmuch.el b/emacs/notmuch.el index 57b7fcf..4c13f32 100644 --- a/emacs/notmuch.el +++ b/emacs/notmuch.el @@ -197,10 +197,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 @@ -210,8 +206,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 "") 'notmuch-search-scroll-down) (define-key map "b" 'notmuch-search-scroll-down) (define-key map " " 'notmuch-search-scroll-up) @@ -244,6 +240,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) @@ -336,6 +340,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) @@ -692,7 +697,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: @@ -710,6 +715,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 @@ -738,11 +744,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)))) (defun notmuch-search-toggle-order () "Toggle the current search order. -- 1.7.0