--- /dev/null
+Return-Path: <dme@dme.org>\r
+X-Original-To: notmuch@notmuchmail.org\r
+Delivered-To: notmuch@notmuchmail.org\r
+Received: from localhost (localhost [127.0.0.1])\r
+ by olra.theworths.org (Postfix) with ESMTP id A2F2E40DF1E\r
+ for <notmuch@notmuchmail.org>; Fri, 19 Nov 2010 09:52:56 -0800 (PST)\r
+X-Virus-Scanned: Debian amavisd-new at olra.theworths.org\r
+X-Spam-Flag: NO\r
+X-Spam-Score: -1.9\r
+X-Spam-Level: \r
+X-Spam-Status: No, score=-1.9 tagged_above=-999 required=5\r
+ tests=[BAYES_00=-1.9, RCVD_IN_DNSWL_NONE=-0.0001] autolearn=ham\r
+Received: from olra.theworths.org ([127.0.0.1])\r
+ by localhost (olra.theworths.org [127.0.0.1]) (amavisd-new, port 10024)\r
+ with ESMTP id f3xlN6U7Xh1Y for <notmuch@notmuchmail.org>;\r
+ Fri, 19 Nov 2010 09:52:45 -0800 (PST)\r
+Received: from mail-wy0-f181.google.com (mail-wy0-f181.google.com\r
+ [74.125.82.181])\r
+ by olra.theworths.org (Postfix) with ESMTP id 174CB40DEF3\r
+ for <notmuch@notmuchmail.org>; Fri, 19 Nov 2010 09:52:44 -0800 (PST)\r
+Received: by wyb40 with SMTP id 40so4959916wyb.26\r
+ for <notmuch@notmuchmail.org>; Fri, 19 Nov 2010 09:52:44 -0800 (PST)\r
+Received: by 10.227.6.226 with SMTP id a34mr2589261wba.77.1290189164047;\r
+ Fri, 19 Nov 2010 09:52:44 -0800 (PST)\r
+Received: from ut.hh.sledj.net (host81-149-164-25.in-addr.btopenworld.com\r
+ [81.149.164.25])\r
+ by mx.google.com with ESMTPS id a17sm1261902wbe.0.2010.11.19.09.52.42\r
+ (version=TLSv1/SSLv3 cipher=RC4-MD5);\r
+ Fri, 19 Nov 2010 09:52:42 -0800 (PST)\r
+Received: by ut.hh.sledj.net (Postfix, from userid 1000)\r
+ id 3BBE4594058; Fri, 19 Nov 2010 17:49:43 +0000 (GMT)\r
+From: David Edmondson <dme@dme.org>\r
+To: notmuch@notmuchmail.org\r
+Subject: [PATCH] emacs: Allow saved search queries to be dynamically\r
+ generated.\r
+Date: Fri, 19 Nov 2010 17:49:39 +0000\r
+Message-Id: <1290188979-7596-1-git-send-email-dme@dme.org>\r
+X-Mailer: git-send-email 1.7.2.3\r
+X-BeenThere: notmuch@notmuchmail.org\r
+X-Mailman-Version: 2.1.13\r
+Precedence: list\r
+List-Id: "Use and development of the notmuch mail system."\r
+ <notmuch.notmuchmail.org>\r
+List-Unsubscribe: <http://notmuchmail.org/mailman/options/notmuch>,\r
+ <mailto:notmuch-request@notmuchmail.org?subject=unsubscribe>\r
+List-Archive: <http://notmuchmail.org/pipermail/notmuch>\r
+List-Post: <mailto:notmuch@notmuchmail.org>\r
+List-Help: <mailto:notmuch-request@notmuchmail.org?subject=help>\r
+List-Subscribe: <http://notmuchmail.org/mailman/listinfo/notmuch>,\r
+ <mailto:notmuch-request@notmuchmail.org?subject=subscribe>\r
+X-List-Received-Date: Fri, 19 Nov 2010 17:52:56 -0000\r
+\r
+>From an idea by Jed Brown: Allow the query string passed to notmuch by\r
+`notmuch-hello' to be the result of a function as well as a\r
+string. The function is passed no arguments and should return the\r
+search string.\r
+\r
+A sample function `notmuch-hello-search-today' is provided.\r
+\r
+Update the customisation declaration of `notmuch-saved-searches'\r
+accordingly.\r
+---\r
+ emacs/notmuch-hello.el | 396 +++++++++++++++++++++++++----------------------\r
+ emacs/notmuch-lib.el | 4 +-\r
+ emacs/notmuch.el | 9 +-\r
+ 3 files changed, 219 insertions(+), 190 deletions(-)\r
+\r
+diff --git a/emacs/notmuch-hello.el b/emacs/notmuch-hello.el\r
+index e58dd24..6337f45 100644\r
+--- a/emacs/notmuch-hello.el\r
++++ b/emacs/notmuch-hello.el\r
+@@ -318,203 +318,229 @@ Complete list of currently available key bindings:\r
+ ;;(setq buffer-read-only t)\r
+ )\r
+ \r
++(defun notmuch-hello-search-today ()\r
++ "Return a notmuch search for 'today'.\r
++\r
++Convenience function for `notmuch-saved-searches'."\r
++ (concat\r
++ (format-time-string "%s" (seconds-to-time\r
++ (- (float-time (current-time))\r
++ (* 60 60 24))))\r
++ ".."\r
++ (format-time-string "%s")))\r
++\r
++(defun notmuch-hello-generate-saved-searches (saved-searches)\r
++ (loop for search-tuple in saved-searches\r
++ collect (cons (car search-tuple)\r
++ (let ((search (cdr search-tuple)))\r
++ (cond\r
++ ((functionp search)\r
++ (funcall search))\r
++ (t ;; Assume a string\r
++ search))))))\r
++\r
+ ;;;###autoload\r
+ (defun notmuch-hello (&optional no-display)\r
+ "Run notmuch and display saved searches, known tags, etc."\r
+ (interactive)\r
+ \r
+- ; Jump through a hoop to get this value from the deprecated variable\r
+- ; name (`notmuch-folders') or from the default value.\r
++ ;; Jump through a hoop to get this value from the deprecated variable\r
++ ;; name (`notmuch-folders') or from the default value.\r
+ (if (not notmuch-saved-searches)\r
+ (setq notmuch-saved-searches (notmuch-saved-searches)))\r
+ \r
+- (if no-display\r
+- (set-buffer "*notmuch-hello*")\r
+- (switch-to-buffer "*notmuch-hello*"))\r
+-\r
+- (let ((target (if (widget-at)\r
+- (widget-value (widget-at))\r
+- (condition-case nil\r
+- (progn\r
+- (widget-forward 1)\r
+- (widget-value (widget-at)))\r
+- (error nil)))))\r
+-\r
+- (kill-all-local-variables)\r
+- (let ((inhibit-read-only t))\r
+- (erase-buffer))\r
+-\r
+- (unless (eq major-mode 'notmuch-hello-mode)\r
+- (notmuch-hello-mode))\r
+-\r
+- (let ((all (overlay-lists)))\r
+- ;; Delete all the overlays.\r
+- (mapc 'delete-overlay (car all))\r
+- (mapc 'delete-overlay (cdr all)))\r
+-\r
+- (when notmuch-show-logo\r
+- (let ((image notmuch-hello-logo))\r
+- ;; The notmuch logo uses transparency. That can display poorly\r
+- ;; when inserting the image into an emacs buffer (black logo on\r
+- ;; a black background), so force the background colour of the\r
+- ;; image. We use a face to represent the colour so that\r
+- ;; `defface' can be used to declare the different possible\r
+- ;; colours, which depend on whether the frame has a light or\r
+- ;; dark background.\r
+- (setq image (cons 'image\r
+- (append (cdr image)\r
+- (list :background (face-background 'notmuch-hello-logo-background)))))\r
+- (insert-image image))\r
+- (widget-insert " "))\r
+-\r
+- (widget-insert "Welcome to ")\r
+- ;; Hack the display of the links used.\r
+- (let ((widget-link-prefix "")\r
+- (widget-link-suffix ""))\r
+- (widget-create 'link\r
+- :notify (lambda (&rest ignore)\r
+- (browse-url notmuch-hello-url))\r
+- :help-echo "Visit the notmuch website."\r
+- "notmuch")\r
+- (widget-insert ". ")\r
+- (widget-insert "You have ")\r
+- (widget-create 'link\r
+- :notify (lambda (&rest ignore)\r
+- (notmuch-hello-update))\r
+- :help-echo "Refresh"\r
+- (notmuch-hello-nice-number\r
+- (string-to-number (car (process-lines notmuch-command "count")))))\r
+- (widget-insert " messages.\n"))\r
+-\r
+- (let ((found-target-pos nil)\r
+- (final-target-pos nil))\r
+- (let* ((saved-alist\r
+- ;; Filter out empty saved seaches if required.\r
+- (if notmuch-show-empty-saved-searches\r
+- notmuch-saved-searches\r
+- (loop for elem in notmuch-saved-searches\r
+- if (> (string-to-number (notmuch-saved-search-count (cdr elem))) 0)\r
+- collect elem)))\r
+- (saved-widest (notmuch-hello-longest-label saved-alist))\r
+- (alltags-alist (if notmuch-show-all-tags-list\r
+- (mapcar '(lambda (tag) (cons tag (concat "tag:" tag)))\r
+- (process-lines notmuch-command "search-tags"))))\r
+- (alltags-widest (notmuch-hello-longest-label alltags-alist))\r
+- (widest (max saved-widest alltags-widest)))\r
+-\r
+- (when saved-alist\r
+- (widget-insert "\nSaved searches: ")\r
+- (widget-create 'push-button\r
+- :notify (lambda (&rest ignore)\r
+- (customize-variable 'notmuch-saved-searches))\r
+- "edit")\r
+- (widget-insert "\n\n")\r
+- (setq final-target-pos (point-marker))\r
+- (let ((start (point)))\r
+- (setq found-target-pos (notmuch-hello-insert-tags saved-alist widest target))\r
+- (if found-target-pos\r
+- (setq final-target-pos found-target-pos))\r
+- (indent-rigidly start (point) notmuch-hello-indent)))\r
+-\r
+- (widget-insert "\nSearch: ")\r
+- (setq notmuch-hello-search-bar-marker (point-marker))\r
+- (widget-create 'editable-field\r
+- ;; Leave some space at the start and end of the\r
+- ;; search boxes.\r
+- :size (max 8 (- (window-width) notmuch-hello-indent\r
+- (length "Search: ")))\r
+- :action (lambda (widget &rest ignore)\r
+- (notmuch-hello-search (widget-value widget))))\r
+- (widget-insert "\n")\r
+-\r
+- (when notmuch-hello-recent-searches\r
+- (widget-insert "\nRecent searches: ")\r
+- (widget-create 'push-button\r
+- :notify (lambda (&rest ignore)\r
+- (setq notmuch-hello-recent-searches nil)\r
+- (notmuch-hello-update))\r
+- "clear")\r
+- (widget-insert "\n\n")\r
+- (let ((start (point))\r
+- (nth 0))\r
+- (mapc '(lambda (search)\r
+- (let ((widget-symbol (intern (format "notmuch-hello-search-%d" nth))))\r
+- (set widget-symbol\r
+- (widget-create 'editable-field\r
+- ;; Don't let the search boxes be\r
+- ;; less than 8 characters wide.\r
+- :size (max 8\r
+- (- (window-width)\r
+- ;; Leave some space\r
+- ;; at the start and\r
+- ;; end of the\r
+- ;; boxes.\r
+- (* 2 notmuch-hello-indent)\r
+- ;; 1 for the space\r
+- ;; before the\r
+- ;; `[save]' button. 6\r
+- ;; for the `[save]'\r
+- ;; button.\r
+- 1 6))\r
+- :action (lambda (widget &rest ignore)\r
+- (notmuch-hello-search (widget-value widget)))\r
+- search))\r
+- (widget-insert " ")\r
+- (widget-create 'push-button\r
+- :notify (lambda (widget &rest ignore)\r
+- (notmuch-hello-add-saved-search widget))\r
+- :notmuch-saved-search-widget widget-symbol\r
+- "save"))\r
+- (widget-insert "\n")\r
+- (setq nth (1+ nth)))\r
+- notmuch-hello-recent-searches)\r
+- (indent-rigidly start (point) notmuch-hello-indent)))\r
+-\r
+- (when alltags-alist\r
+- (widget-insert "\nAll tags: ")\r
+- (widget-create 'push-button\r
+- :notify (lambda (widget &rest ignore)\r
+- (setq notmuch-show-all-tags-list nil)\r
+- (notmuch-hello-update))\r
+- "hide")\r
+- (widget-insert "\n\n")\r
+- (let ((start (point)))\r
+- (setq found-target-pos (notmuch-hello-insert-tags alltags-alist widest target))\r
+- (if (not final-target-pos)\r
+- (setq final-target-pos found-target-pos))\r
+- (indent-rigidly start (point) notmuch-hello-indent)))\r
+-\r
+- (widget-insert "\n")\r
+-\r
+- (if (not notmuch-show-all-tags-list)\r
++ ;; Generate the string version of all queries listed in\r
++ ;; `notmuch-saved-searches'. We do this here at the start so that\r
++ ;; the rest of the routine has a stable set to work from.\r
++ (let ((saved-searches (notmuch-hello-generate-saved-searches notmuch-saved-searches)))\r
++\r
++ (if no-display\r
++ (set-buffer "*notmuch-hello*")\r
++ (switch-to-buffer "*notmuch-hello*"))\r
++\r
++ (let ((target (if (widget-at)\r
++ (widget-value (widget-at))\r
++ (condition-case nil\r
++ (progn\r
++ (widget-forward 1)\r
++ (widget-value (widget-at)))\r
++ (error nil)))))\r
++\r
++ (kill-all-local-variables)\r
++ (let ((inhibit-read-only t))\r
++ (erase-buffer))\r
++\r
++ (unless (eq major-mode 'notmuch-hello-mode)\r
++ (notmuch-hello-mode))\r
++\r
++ (let ((all (overlay-lists)))\r
++ ;; Delete all the overlays.\r
++ (mapc 'delete-overlay (car all))\r
++ (mapc 'delete-overlay (cdr all)))\r
++\r
++ (when notmuch-show-logo\r
++ (let ((image notmuch-hello-logo))\r
++ ;; The notmuch logo uses transparency. That can display poorly\r
++ ;; when inserting the image into an emacs buffer (black logo on\r
++ ;; a black background), so force the background colour of the\r
++ ;; image. We use a face to represent the colour so that\r
++ ;; `defface' can be used to declare the different possible\r
++ ;; colours, which depend on whether the frame has a light or\r
++ ;; dark background.\r
++ (setq image (cons 'image\r
++ (append (cdr image)\r
++ (list :background (face-background 'notmuch-hello-logo-background)))))\r
++ (insert-image image))\r
++ (widget-insert " "))\r
++\r
++ (widget-insert "Welcome to ")\r
++ ;; Hack the display of the links used.\r
++ (let ((widget-link-prefix "")\r
++ (widget-link-suffix ""))\r
++ (widget-create 'link\r
++ :notify (lambda (&rest ignore)\r
++ (browse-url notmuch-hello-url))\r
++ :help-echo "Visit the notmuch website."\r
++ "notmuch")\r
++ (widget-insert ". ")\r
++ (widget-insert "You have ")\r
++ (widget-create 'link\r
++ :notify (lambda (&rest ignore)\r
++ (notmuch-hello-update))\r
++ :help-echo "Refresh"\r
++ (notmuch-hello-nice-number\r
++ (string-to-number (car (process-lines notmuch-command "count")))))\r
++ (widget-insert " messages.\n"))\r
++\r
++ (let ((found-target-pos nil)\r
++ (final-target-pos nil))\r
++ (let* ((saved-alist\r
++ ;; Filter out empty saved seaches if required.\r
++ (if notmuch-show-empty-saved-searches\r
++ saved-searches\r
++ (loop for elem in saved-searches\r
++ if (> (string-to-number (notmuch-saved-search-count (cdr elem))) 0)\r
++ collect elem)))\r
++ (saved-widest (notmuch-hello-longest-label saved-alist))\r
++ (alltags-alist (if notmuch-show-all-tags-list\r
++ (mapcar '(lambda (tag) (cons tag (concat "tag:" tag)))\r
++ (process-lines notmuch-command "search-tags"))))\r
++ (alltags-widest (notmuch-hello-longest-label alltags-alist))\r
++ (widest (max saved-widest alltags-widest)))\r
++\r
++ (when saved-alist\r
++ (widget-insert "\nSaved searches: ")\r
++ (widget-create 'push-button\r
++ :notify (lambda (&rest ignore)\r
++ (customize-variable 'notmuch-saved-searches))\r
++ "edit")\r
++ (widget-insert "\n\n")\r
++ (setq final-target-pos (point-marker))\r
++ (let ((start (point)))\r
++ (setq found-target-pos (notmuch-hello-insert-tags saved-alist widest target))\r
++ (if found-target-pos\r
++ (setq final-target-pos found-target-pos))\r
++ (indent-rigidly start (point) notmuch-hello-indent)))\r
++\r
++ (widget-insert "\nSearch: ")\r
++ (setq notmuch-hello-search-bar-marker (point-marker))\r
++ (widget-create 'editable-field\r
++ ;; Leave some space at the start and end of the\r
++ ;; search boxes.\r
++ :size (max 8 (- (window-width) notmuch-hello-indent\r
++ (length "Search: ")))\r
++ :action (lambda (widget &rest ignore)\r
++ (notmuch-hello-search (widget-value widget))))\r
++ (widget-insert "\n")\r
++\r
++ (when notmuch-hello-recent-searches\r
++ (widget-insert "\nRecent searches: ")\r
++ (widget-create 'push-button\r
++ :notify (lambda (&rest ignore)\r
++ (setq notmuch-hello-recent-searches nil)\r
++ (notmuch-hello-update))\r
++ "clear")\r
++ (widget-insert "\n\n")\r
++ (let ((start (point))\r
++ (nth 0))\r
++ (mapc '(lambda (search)\r
++ (let ((widget-symbol (intern (format "notmuch-hello-search-%d" nth))))\r
++ (set widget-symbol\r
++ (widget-create 'editable-field\r
++ ;; Don't let the search boxes be\r
++ ;; less than 8 characters wide.\r
++ :size (max 8\r
++ (- (window-width)\r
++ ;; Leave some space\r
++ ;; at the start and\r
++ ;; end of the\r
++ ;; boxes.\r
++ (* 2 notmuch-hello-indent)\r
++ ;; 1 for the space\r
++ ;; before the\r
++ ;; `[save]' button. 6\r
++ ;; for the `[save]'\r
++ ;; button.\r
++ 1 6))\r
++ :action (lambda (widget &rest ignore)\r
++ (notmuch-hello-search (widget-value widget)))\r
++ search))\r
++ (widget-insert " ")\r
++ (widget-create 'push-button\r
++ :notify (lambda (widget &rest ignore)\r
++ (notmuch-hello-add-saved-search widget))\r
++ :notmuch-saved-search-widget widget-symbol\r
++ "save"))\r
++ (widget-insert "\n")\r
++ (setq nth (1+ nth)))\r
++ notmuch-hello-recent-searches)\r
++ (indent-rigidly start (point) notmuch-hello-indent)))\r
++\r
++ (when alltags-alist\r
++ (widget-insert "\nAll tags: ")\r
+ (widget-create 'push-button\r
+ :notify (lambda (widget &rest ignore)\r
+- (setq notmuch-show-all-tags-list t)\r
++ (setq notmuch-show-all-tags-list nil)\r
+ (notmuch-hello-update))\r
+- "Show all tags")))\r
+-\r
+- (let ((start (point)))\r
+- (widget-insert "\n\n")\r
+- (widget-insert "Type a search query and hit RET to view matching threads.\n")\r
+- (when notmuch-hello-recent-searches\r
+- (widget-insert "Hit RET to re-submit a previous search. Edit it first if you like.\n")\r
+- (widget-insert "Save recent searches with the `save' button.\n"))\r
+- (when notmuch-saved-searches\r
+- (widget-insert "Edit saved searches with the `edit' button.\n"))\r
+- (widget-insert "Hit RET or click on a saved search or tag name to view matching threads.\n")\r
+- (widget-insert "`=' refreshes this screen. `s' jumps to the search box. `q' to quit.\n")\r
+- (let ((fill-column (- (window-width) notmuch-hello-indent)))\r
+- (center-region start (point))))\r
+-\r
+- (widget-setup)\r
+-\r
+- (when final-target-pos\r
+- (goto-char final-target-pos)\r
+- (unless (widget-at)\r
+- (widget-forward 1)))\r
++ "hide")\r
++ (widget-insert "\n\n")\r
++ (let ((start (point)))\r
++ (setq found-target-pos (notmuch-hello-insert-tags alltags-alist widest target))\r
++ (if (not final-target-pos)\r
++ (setq final-target-pos found-target-pos))\r
++ (indent-rigidly start (point) notmuch-hello-indent)))\r
++\r
++ (widget-insert "\n")\r
++\r
++ (if (not notmuch-show-all-tags-list)\r
++ (widget-create 'push-button\r
++ :notify (lambda (widget &rest ignore)\r
++ (setq notmuch-show-all-tags-list t)\r
++ (notmuch-hello-update))\r
++ "Show all tags")))\r
++\r
++ (let ((start (point)))\r
++ (widget-insert "\n\n")\r
++ (widget-insert "Type a search query and hit RET to view matching threads.\n")\r
++ (when notmuch-hello-recent-searches\r
++ (widget-insert "Hit RET to re-submit a previous search. Edit it first if you like.\n")\r
++ (widget-insert "Save recent searches with the `save' button.\n"))\r
++ (when notmuch-saved-searches\r
++ (widget-insert "Edit saved searches with the `edit' button.\n"))\r
++ (widget-insert "Hit RET or click on a saved search or tag name to view matching threads.\n")\r
++ (widget-insert "`=' refreshes this screen. `s' jumps to the search box. `q' to quit.\n")\r
++ (let ((fill-column (- (window-width) notmuch-hello-indent)))\r
++ (center-region start (point))))\r
++\r
++ (widget-setup)\r
++\r
++ (when final-target-pos\r
++ (goto-char final-target-pos)\r
++ (unless (widget-at)\r
++ (widget-forward 1)))\r
+ \r
+- (unless (widget-at)\r
+- (notmuch-hello-goto-search)))))\r
++ (unless (widget-at)\r
++ (notmuch-hello-goto-search))))))\r
+ \r
+ (defun notmuch-folder ()\r
+ "Deprecated function for invoking notmuch---calling `notmuch' is preferred now."\r
+diff --git a/emacs/notmuch-lib.el b/emacs/notmuch-lib.el\r
+index 9d4e00f..9712f01 100644\r
+--- a/emacs/notmuch-lib.el\r
++++ b/emacs/notmuch-lib.el\r
+@@ -37,7 +37,9 @@\r
+ \r
+ (defcustom notmuch-saved-searches nil\r
+ "A list of saved searches to display."\r
+- :type '(alist :key-type string :value-type string)\r
++ :type '(alist :key-type (string :tag "Name")\r
++ :value-type (choice (string :tag "Search")\r
++ (function :tag "Function")))\r
+ :group 'notmuch)\r
+ \r
+ (defvar notmuch-folders nil\r
+diff --git a/emacs/notmuch.el b/emacs/notmuch.el\r
+index b003cd6..e8d4d98 100644\r
+--- a/emacs/notmuch.el\r
++++ b/emacs/notmuch.el\r
+@@ -808,10 +808,11 @@ characters as well as `_.+-'.\r
+ (let (longest\r
+ (longest-length 0))\r
+ (loop for tuple in notmuch-saved-searches\r
+- if (let ((quoted-query (regexp-quote (cdr tuple))))\r
+- (and (string-match (concat "^" quoted-query) query)\r
+- (> (length (match-string 0 query))\r
+- longest-length)))\r
++ if (and (stringp (cdr tuple))\r
++ (let ((quoted-query (regexp-quote (cdr tuple))))\r
++ (and (string-match (concat "^" quoted-query) query)\r
++ (> (length (match-string 0 query))\r
++ longest-length))))\r
+ do (setq longest tuple))\r
+ longest))\r
+ (saved-search-name (car saved-search))\r
+-- \r
+1.7.2.3\r
+\r
projects / notmuch-archives.git / commitdiff