emacs: Make the queries used in the all-tags section configurable
authorDaniel Schoepe <daniel.schoepe@googlemail.com>
Wed, 25 May 2011 21:21:54 +0000 (23:21 +0200)
committerCarl Worth <cworth@cworth.org>
Thu, 26 May 2011 21:34:41 +0000 (14:34 -0700)
This patch adds a customization variable that controls what queries
are used to construct the all-tags section in notmuch-hello. It allows
the user to specify a function to construct the query given a tag or
a string that is used as a filter for each tag.
It also adds a variable to hide various tags from the all-tags section.

Signed-off-by: Daniel Schoepe <daniel.schoepe@googlemail.com>
emacs/notmuch-hello.el
emacs/notmuch-lib.el

index ab06d3a6a9c1937a2183f4bd10d534eed567f22a..916cda1cc5d25b2a51a9e9325f2efb1065ca8241 100644 (file)
   :type 'boolean
   :group 'notmuch)
 
+(defcustom notmuch-hello-tag-list-make-query nil
+  "Function or string to generate queries for the all tags list.
+
+This variable controls which query results are shown for each tag
+in the \"all tags\" list. If nil, it will use all messages with
+that tag. If this is set to a string, it is used as a filter for
+messages having that tag (equivalent to \"tag:TAG and (THIS-VARIABLE)\").
+Finally this can be a function that will be called for each tag and
+should return a filter for that tag, or nil to hide the tag."
+  :type '(choice (const :tag "All messages" nil)
+                (const :tag "Unread messages" "tag:unread")
+                (const :tag "Custom filter" string)
+                (const :tag "Custom filter function" function))
+  :group 'notmuch)
+
+(defcustom notmuch-hello-hide-tags nil
+  "List of tags to be hidden in the \"all tags\"-section."
+  :type '(repeat string)
+  :group 'notmuch)
+
 (defface notmuch-hello-logo-background
   '((((class color)
       (background dark))
@@ -318,6 +338,25 @@ Complete list of currently available key bindings:
  ;;(setq buffer-read-only t)
 )
 
+(defun notmuch-hello-generate-tag-alist ()
+  "Return an alist from tags to queries to display in the all-tags section."
+  (notmuch-remove-if-not
+   #'cdr
+   (mapcar (lambda (tag)
+            (cons tag
+                  (cond
+                   ((functionp notmuch-hello-tag-list-make-query)
+                    (concat "tag:" tag " and ("
+                            (funcall notmuch-hello-tag-list-make-query tag) ")"))
+                   ((stringp notmuch-hello-tag-list-make-query)
+                    (concat "tag:" tag " and ("
+                            notmuch-hello-tag-list-make-query ")"))
+                   (t (concat "tag:" tag)))))
+          (notmuch-remove-if-not
+           (lambda (tag)
+             (not (member tag notmuch-hello-hide-tags)))
+           (process-lines notmuch-command "search-tags")))))
+
 ;;;###autoload
 (defun notmuch-hello (&optional no-display)
   "Run notmuch and display saved searches, known tags, etc."
@@ -396,9 +435,7 @@ Complete list of currently available key bindings:
                      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-alist (if notmuch-show-all-tags-list (notmuch-hello-generate-tag-alist)))
             (alltags-widest (notmuch-hello-longest-label alltags-alist))
             (widest (max saved-widest alltags-widest)))
 
index cc80fb29ee24a5f6d59b77e1a3632719b67ae726..d5ca0f404ff5de3d529c946c0e05e0927186a7f4 100644 (file)
@@ -120,6 +120,15 @@ within the current window."
       (or (memq prop buffer-invisibility-spec)
          (assq prop buffer-invisibility-spec)))))
 
+(defun notmuch-remove-if-not (predicate list)
+  "Return a copy of LIST with all items not satisfying PREDICATE removed."
+  (let (out)
+    (while list
+      (when (funcall predicate (car list))
+        (push (car list) out))
+      (setq list (cdr list)))
+    (nreverse out)))
+
 ; This lets us avoid compiling these replacement functions when emacs
 ; is sufficiently new enough to supply them alone. We do the macro
 ; treatment rather than just wrapping our defun calls in a when form