* [PATCH] emacs: User-defined sections in notmuch-hello
@ 2011-05-27 18:52 Daniel Schoepe
2011-05-27 21:41 ` Daniel Schoepe
2011-06-03 13:46 ` Daniel Schoepe
0 siblings, 2 replies; 5+ messages in thread
From: Daniel Schoepe @ 2011-05-27 18:52 UTC (permalink / raw)
To: notmuch
[-- Attachment #1.1: Type: text/plain, Size: 920 bytes --]
From the commit message:
> This patch allows the user to define various sections that will
> be displayed in notmuch-hello. I tried to keep the section
> description flexible, so it allows different queries for the
> tag buttons and the counts next to them, as well as hiding items
> with zero results.
>
> The sections are (hopefully) fully editable using customize.
>
> I have not yet rewritten the saved-searches portion using this
> mechanism, to avoid breaking the configurations of many users.
It contains a lot of code to make the whole thing play nice with
customize, but hey, at least it's (somewhat) user-friendly. :)
I'm also not sure if using plists to describe the sections was a
particularly (e)lispy way to do this, so comments are appreciated.
I'll also work on some tests for this functionality, (if no one
has big, structural complaints about the code).
Cheers,
Daniel
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #1.2: 0001-emacs-User-defined-sections-in-notmuch-hello.patch --]
[-- Type: text/x-diff, Size: 18351 bytes --]
From bca5a58d7910b6d46a782db787dfe07e2fcf21e1 Mon Sep 17 00:00:00 2001
From: Daniel Schoepe <daniel.schoepe@googlemail.com>
Date: Thu, 26 May 2011 23:03:22 +0200
Subject: [PATCH] emacs: User-defined sections in notmuch-hello
This patch allows the user to define various sections that will
be displayed in notmuch-hello. I tried to keep the section
description flexible, so it allows different queries for the
tag buttons and the counts next to them, as well as hiding items
with zero results.
The sections are (hopefully) fully editable using customize.
I have not yet rewritten the saved-searches portion using this
mechanism, to avoid breaking the configurations of many users.
---
emacs/notmuch-hello.el | 328 ++++++++++++++++++++++++++++++++++++++----------
emacs/notmuch-lib.el | 22 ++--
2 files changed, 275 insertions(+), 75 deletions(-)
diff --git a/emacs/notmuch-hello.el b/emacs/notmuch-hello.el
index 916cda1..40333ae 100644
--- a/emacs/notmuch-hello.el
+++ b/emacs/notmuch-hello.el
@@ -55,24 +55,115 @@
: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)
+(defvar notmuch-hello-section-all-tags
+ (list :title "All tags:"
+ :type 'eachtag)
+ "Default section definition for the \"all tags\" section.")
+
+(defvar notmuch-hello-section-unread-tags
+ (list :title "All tags, unread only:"
+ :type 'eachtag
+ :make-query "tag:unread")
+ "Show and count only unread messages for each tag.")
+
+(defvar notmuch-hello-hidden-sections nil
+ "Sections that are hidden in notmuch-hello")
+
+(defvar notmuch-hello-first-run t
+ "Internal variable for hiding sections with :hidden-on-startup")
+
+(define-widget 'notmuch-section-query-type 'lazy
+ "Customize-type for query items"
+ :tag "Query item"
+ :type '(list (string :tag "Search title")
+ (string :tag "Query to use")
+ (choice :tag "Query for message count"
+ (const :tag "Use previous query" nil)
+ (string :tag "Different query"))))
+
+(define-widget 'notmuch-section-make-query-type 'lazy
+ "Customize-type for query functions"
+ :tag "Query function"
+ :type '(choice (const :tag "All messages with tag" nil)
+ (const :tag "Only unread messages" "tag:unread")
+ (string :tag "Custom filter string")
+ (function :tag "Custom filter function")))
+
+(define-widget 'notmuch-section-type 'lazy
+ "Customize-type for sections"
+ :tag "Custom section"
+ :type
+ '(plist :options (((const :tag "Title for this section" :title)
+ string)
+ ((const :tag "Type of this section" :type)
+ (choice (const :tag "One item for each tag"
+ eachtag)
+ (const :tag "Custom list of searches"
+ query-list)))
+ ((const :tag "Function to generate a query, ignored if custom list"
+ :make-query)
+ notmuch-section-make-query)
+ ((const :tag "Function to generate counts, ignored if custom list"
+ :make-count)
+ notmuch-section-make-query)
+ ((const :tag "Function to create titles for tag entries, ignored if custom list"
+ :make-title)
+ (choice (const :tag "The tag itself" nil)
+ (function :tag "Custom function")))
+ ((const :tag "List of tags to hide, ignored if custom list"
+ :hide-tags)
+ (repeat (string :tag "tag")))
+ ((const :tag "Search queries, only used if custom list"
+ :items)
+ (repeat notmuch-section-query))
+ ((const :tag "Hide if there are no results" :hide-empty)
+ boolean)
+ ((const :tag "Where should this be positioned" :position)
+ (choice (const :tag "Before the search input" before)
+ (const :tag "After the search input" after))))))
+
+(defcustom notmuch-hello-sections (list notmuch-hello-section-all-tags)
+ "Sections to be displayed in notmuch-hello.
+
+This variable does not include the saved-searches section, which
+is handled separately.
+This variable should be a list of plists with the following
+possible properties:
+
+:title - The title of the section
+:type - Can be 'eachtag or 'query-list, If 'eachtag, generate one
+ item for each tag, otherwise use a fixed set of items.
+The following options are only used when type is 'eachtag:
+:make-query - This can be a query string that is used as a filter for all
+ messages that contain this tag. This can also be a function
+ that is given is tag and should return a filter query. If
+ it returns nil, the tag will be hidden. If nil, all
+ messages having the tag will be used.
+:make-count - Query used to generate message counts next to the labels,
+ same type as :make-query. If this is nil, the same query as
+ above will be used.
+:make-title - Function to generate an alternative title for each tag item.
+ Can be nil.
+:hide-tags - List of tags that will be hidden.
+
+If :type is 'query-list, the following entry must be set:
+:items - List of cons-cells of a title and a query for that item,
+ and/or of lists of the form (TITLE QUERY COUNT), where COUNT is
+ used to generate the message count instead of QUERY. (To make
+ the customize-interface nicer, COUNT is also allowed to be nil).
+
+The following properties are valid for both :type's:
+:hide-empty - If non-nil, hide items that have no matching messages
+:position - If 'before, it will be displayed before the search input form, otherwise
+ after the recent searches.
+:hidden-on-startup - If non-nil, this section will be hidden when notmuch-hello
+ is first run."
+ :type `(repeat
+ (choice (const :tag "Show all messages for each tag"
+ ,notmuch-hello-section-all-tags)
+ (const :tag "Only unread messages for each tag"
+ ,notmuch-hello-section-unread-tags)
+ notmuch-section-type))
:group 'notmuch)
(defface notmuch-hello-logo-background
@@ -238,12 +329,32 @@ should be. Returns a cons cell `(tags-per-line width)'."
(* tags-per-line (+ 9 1))))
tags-per-line))))
-(defun notmuch-hello-insert-tags (tag-alist widest target)
+(defun notmuch-hello-get-count-query (query-item)
+ (if (consp (cdr query-item))
+ (or (third query-item) (second query-item))
+ (cdr query-item)))
+
+(defun notmuch-hello-insert-tags (tag-alist widest target &optional show-empty)
(let* ((tags-and-width (notmuch-hello-tags-per-line widest))
(tags-per-line (car tags-and-width))
+ (count-alist
+ (mapcar
+ (lambda (tag-entry)
+ (cons (car tag-entry)
+ (string-to-number (notmuch-saved-search-count
+ (notmuch-hello-get-count-query tag-entry)))))
+ tag-alist))
+ (tag-alist-filtered
+ (if show-empty
+ tag-alist
+ (notmuch-remove-if-not
+ (lambda (tag-entry)
+ ;; filter out entries that have 0 results
+ (and (not (eq 0 (cdr (assoc (car tag-entry) count-alist)))) tag-entry))
+ tag-alist)))
(widest (cdr tags-and-width))
(count 0)
- (reordered-list (notmuch-hello-reflect tag-alist tags-per-line))
+ (reordered-list (notmuch-hello-reflect tag-alist-filtered tags-per-line))
;; Hack the display of the buttons used.
(widget-push-button-prefix "")
(widget-push-button-suffix "")
@@ -254,11 +365,14 @@ should be. Returns a cons cell `(tags-per-line width)'."
;; (not elem) indicates an empty slot in the matrix.
(when elem
(let* ((name (car elem))
- (query (cdr elem))
+ (query (if (consp (cdr elem))
+ (second elem)
+ (cdr elem)))
+ (count-query (notmuch-hello-get-count-query elem))
(formatted-name (format "%s " name)))
(widget-insert (format "%8s "
(notmuch-hello-nice-number
- (string-to-number (notmuch-saved-search-count query)))))
+ (cdr (assoc name count-alist)))))
(if (string= formatted-name target)
(setq found-target-pos (point-marker)))
(widget-create 'push-button
@@ -338,24 +452,92 @@ 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")))))
+(defun notmuch-hello-section-tag-to-title (section tag)
+ (let ((make-title (plist-get section :make-title)))
+ (if make-title
+ (funcall make-title tag)
+ tag)))
+
+(defun notmuch-hello-section-get-widest (section)
+ "Return widest title string in SECTION."
+ (case (plist-get section :type)
+ ('eachtag (apply #'max
+ (mapcar (lambda (tag)
+ (length (notmuch-hello-section-tag-to-title section tag)))
+ (notmuch-all-tags))))
+ ('query-list (apply #'max
+ (mapcar (lambda (entry) (length (first entry)))
+ (plist-get section :items))))
+ (t (message (concat "Unknown section type: "
+ (prin1-to-string (plist-get section :type)))))))
+
+(defun notmuch-hello-generate-tag-alist (section)
+ "Generate an alist of tags as expected by notmuch-insert-tags for SECTION.
+
+This function handles the special case that section is of type 'eachtag"
+ (let ((make-tag (lambda (make-entry tag)
+ (cond
+ ((functionp make-entry)
+ (let ((query (funcall make-entry tag)))
+ (and query
+ (concat "tag:" tag " and (" query ")"))))
+ ((stringp make-entry)
+ (concat "tag:" tag " and (" make-entry ")"))
+ (t (concat "tag:" tag))))))
+ ;; remove tags for which make-query returned nil
+ (delq nil
+ (mapcar (lambda (tag)
+ (let ((title
+ (notmuch-hello-section-tag-to-title section tag))
+ (query (funcall make-tag
+ (plist-get section :make-query) tag))
+ (count (plist-get section :make-count)))
+ (and query
+ (if count
+ (list title query (funcall make-tag count tag))
+ (cons title query)))))
+ ;; remove tags from :hide-tags
+ (notmuch-remove-if-not
+ (lambda (tag)
+ (not (member tag (plist-get section :hide-tags))))
+ (notmuch-all-tags))))))
+
+(defun notmuch-hello-section-to-alist (section)
+ "Generate an alist of tags as expected by notmuch-insert-tags for SECTION."
+ (case (plist-get section :type)
+ ('eachtag (notmuch-hello-generate-tag-alist section))
+ ('query-list (plist-get section :items))
+ (t (message (concat "Unknown section type: "
+ (prin1-to-string (plist-get section :type)))))))
+
+
+(defun notmuch-hello-insert-section (section widest target)
+"Insert all UI elements for SECTION in the current buffer."
+ (let* ((tags-alist (notmuch-hello-section-to-alist section))
+ (title (plist-get section :title))
+ (hidden (member title notmuch-hello-hidden-sections))
+ (hide-empty (plist-get section :hide-empty))
+ target-pos)
+ (widget-insert (concat "\n" title " "))
+ (when hidden
+ (widget-create 'push-button
+ :notify `(lambda (widget &rest ignore)
+ (setq notmuch-hello-hidden-sections
+ (delq ,title notmuch-hello-hidden-sections))
+ (notmuch-hello-update))
+ "show"))
+ (when (not hidden)
+ (widget-create 'push-button
+ :notify `(lambda (widget &rest ignore)
+ (add-to-list 'notmuch-hello-hidden-sections ,title)
+ (notmuch-hello-update))
+ "hide")
+ (widget-insert "\n\n")
+ (let ((start (point)))
+ (setq target-pos (notmuch-hello-insert-tags tags-alist widest target
+ (not hide-empty)))
+ (indent-rigidly start (point) notmuch-hello-indent))
+ target-pos)))
;;;###autoload
(defun notmuch-hello (&optional no-display)
@@ -426,7 +608,30 @@ Complete list of currently available key bindings:
(widget-insert " messages.\n"))
(let ((found-target-pos nil)
- (final-target-pos nil))
+ (final-target-pos nil)
+ (upper-sections (notmuch-remove-if-not
+ (lambda (section) (eq (plist-get section :position)
+ 'before))
+ notmuch-hello-sections))
+ (lower-sections (notmuch-remove-if-not
+ (lambda (section) (not (eq (plist-get section :position)
+ 'before)))
+ notmuch-hello-sections)))
+
+ ;; handle sections that should be hidden initially
+ (when notmuch-hello-first-run
+ (mapc (lambda (section)
+ (if (plist-get section :hidden-on-startup)
+ (add-to-list 'notmuch-hello-hidden-sections
+ (plist-get section :title))))
+ notmuch-hello-sections)
+ ;; special case for notmuch-show-all-tags-list
+ (when (and (not notmuch-show-all-tags-list)
+ (member notmuch-hello-section-all-tags notmuch-hello-sections))
+ (add-to-list 'notmuch-hello-hidden-sections
+ (plist-get notmuch-hello-section-all-tags :title)))
+ (setq notmuch-hello-first-run nil))
+
(let* ((saved-alist
;; Filter out empty saved seaches if required.
(if notmuch-show-empty-saved-searches
@@ -435,9 +640,9 @@ 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 (notmuch-hello-generate-tag-alist)))
- (alltags-widest (notmuch-hello-longest-label alltags-alist))
- (widest (max saved-widest alltags-widest)))
+ (sections-widest (apply #'max (mapcar #'notmuch-hello-section-get-widest
+ notmuch-hello-sections)))
+ (widest (max saved-widest sections-widest)))
(when saved-alist
(widget-insert "\nSaved searches: ")
@@ -453,6 +658,13 @@ Complete list of currently available key bindings:
(setq final-target-pos found-target-pos))
(indent-rigidly start (point) notmuch-hello-indent)))
+ (mapc (lambda (section)
+ (setq found-target-pos
+ (notmuch-hello-insert-section section widest target))
+ (unless final-target-pos
+ (setq final-target-pos found-target-pos)))
+ upper-sections)
+
(widget-insert "\nSearch: ")
(setq notmuch-hello-search-bar-marker (point-marker))
(widget-create 'editable-field
@@ -507,28 +719,12 @@ Complete list of currently available key bindings:
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)
- (widget-create 'push-button
- :notify (lambda (widget &rest ignore)
- (setq notmuch-show-all-tags-list t)
- (notmuch-hello-update))
- "Show all tags")))
+ (mapc (lambda (section)
+ (setq found-target-pos
+ (notmuch-hello-insert-section section widest target))
+ (unless final-target-pos
+ (setq final-target-pos found-target-pos)))
+ lower-sections))
(let ((start (point)))
(widget-insert "\n\n")
diff --git a/emacs/notmuch-lib.el b/emacs/notmuch-lib.el
index d5ca0f4..615abad 100644
--- a/emacs/notmuch-lib.el
+++ b/emacs/notmuch-lib.el
@@ -103,6 +103,19 @@ the user hasn't set this variable with the old or new value."
(kill-new text)
(message "Stashed: %s" text))
+(defun notmuch-all-tags ()
+ "Return a list of all tags in the database"
+ (process-lines "notmuch" "search-tags"))
+
+(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)))
+
;;
;; XXX: This should be a generic function in emacs somewhere, not
@@ -120,15 +133,6 @@ 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
--
1.7.5.1
[-- Attachment #2: Type: application/pgp-signature, Size: 835 bytes --]
^ permalink raw reply related [flat|nested] 5+ messages in thread
* Re: [PATCH] emacs: User-defined sections in notmuch-hello
2011-05-27 18:52 [PATCH] emacs: User-defined sections in notmuch-hello Daniel Schoepe
@ 2011-05-27 21:41 ` Daniel Schoepe
2011-05-27 21:51 ` Daniel Schoepe
2011-06-03 13:46 ` Daniel Schoepe
1 sibling, 1 reply; 5+ messages in thread
From: Daniel Schoepe @ 2011-05-27 21:41 UTC (permalink / raw)
To: notmuch
[-- Attachment #1.1: Type: text/plain, Size: 136 bytes --]
I forgot to run the test suite with the previous patch, which
revealed some minor formatting problems, updated patch in the
attachment.
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #1.2: 0001-emacs-User-defined-sections-in-notmuch-hello.patch --]
[-- Type: text/x-diff, Size: 18351 bytes --]
From bca5a58d7910b6d46a782db787dfe07e2fcf21e1 Mon Sep 17 00:00:00 2001
From: Daniel Schoepe <daniel.schoepe@googlemail.com>
Date: Thu, 26 May 2011 23:03:22 +0200
Subject: [PATCH] emacs: User-defined sections in notmuch-hello
This patch allows the user to define various sections that will
be displayed in notmuch-hello. I tried to keep the section
description flexible, so it allows different queries for the
tag buttons and the counts next to them, as well as hiding items
with zero results.
The sections are (hopefully) fully editable using customize.
I have not yet rewritten the saved-searches portion using this
mechanism, to avoid breaking the configurations of many users.
---
emacs/notmuch-hello.el | 328 ++++++++++++++++++++++++++++++++++++++----------
emacs/notmuch-lib.el | 22 ++--
2 files changed, 275 insertions(+), 75 deletions(-)
diff --git a/emacs/notmuch-hello.el b/emacs/notmuch-hello.el
index 916cda1..40333ae 100644
--- a/emacs/notmuch-hello.el
+++ b/emacs/notmuch-hello.el
@@ -55,24 +55,115 @@
: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)
+(defvar notmuch-hello-section-all-tags
+ (list :title "All tags:"
+ :type 'eachtag)
+ "Default section definition for the \"all tags\" section.")
+
+(defvar notmuch-hello-section-unread-tags
+ (list :title "All tags, unread only:"
+ :type 'eachtag
+ :make-query "tag:unread")
+ "Show and count only unread messages for each tag.")
+
+(defvar notmuch-hello-hidden-sections nil
+ "Sections that are hidden in notmuch-hello")
+
+(defvar notmuch-hello-first-run t
+ "Internal variable for hiding sections with :hidden-on-startup")
+
+(define-widget 'notmuch-section-query-type 'lazy
+ "Customize-type for query items"
+ :tag "Query item"
+ :type '(list (string :tag "Search title")
+ (string :tag "Query to use")
+ (choice :tag "Query for message count"
+ (const :tag "Use previous query" nil)
+ (string :tag "Different query"))))
+
+(define-widget 'notmuch-section-make-query-type 'lazy
+ "Customize-type for query functions"
+ :tag "Query function"
+ :type '(choice (const :tag "All messages with tag" nil)
+ (const :tag "Only unread messages" "tag:unread")
+ (string :tag "Custom filter string")
+ (function :tag "Custom filter function")))
+
+(define-widget 'notmuch-section-type 'lazy
+ "Customize-type for sections"
+ :tag "Custom section"
+ :type
+ '(plist :options (((const :tag "Title for this section" :title)
+ string)
+ ((const :tag "Type of this section" :type)
+ (choice (const :tag "One item for each tag"
+ eachtag)
+ (const :tag "Custom list of searches"
+ query-list)))
+ ((const :tag "Function to generate a query, ignored if custom list"
+ :make-query)
+ notmuch-section-make-query)
+ ((const :tag "Function to generate counts, ignored if custom list"
+ :make-count)
+ notmuch-section-make-query)
+ ((const :tag "Function to create titles for tag entries, ignored if custom list"
+ :make-title)
+ (choice (const :tag "The tag itself" nil)
+ (function :tag "Custom function")))
+ ((const :tag "List of tags to hide, ignored if custom list"
+ :hide-tags)
+ (repeat (string :tag "tag")))
+ ((const :tag "Search queries, only used if custom list"
+ :items)
+ (repeat notmuch-section-query))
+ ((const :tag "Hide if there are no results" :hide-empty)
+ boolean)
+ ((const :tag "Where should this be positioned" :position)
+ (choice (const :tag "Before the search input" before)
+ (const :tag "After the search input" after))))))
+
+(defcustom notmuch-hello-sections (list notmuch-hello-section-all-tags)
+ "Sections to be displayed in notmuch-hello.
+
+This variable does not include the saved-searches section, which
+is handled separately.
+This variable should be a list of plists with the following
+possible properties:
+
+:title - The title of the section
+:type - Can be 'eachtag or 'query-list, If 'eachtag, generate one
+ item for each tag, otherwise use a fixed set of items.
+The following options are only used when type is 'eachtag:
+:make-query - This can be a query string that is used as a filter for all
+ messages that contain this tag. This can also be a function
+ that is given is tag and should return a filter query. If
+ it returns nil, the tag will be hidden. If nil, all
+ messages having the tag will be used.
+:make-count - Query used to generate message counts next to the labels,
+ same type as :make-query. If this is nil, the same query as
+ above will be used.
+:make-title - Function to generate an alternative title for each tag item.
+ Can be nil.
+:hide-tags - List of tags that will be hidden.
+
+If :type is 'query-list, the following entry must be set:
+:items - List of cons-cells of a title and a query for that item,
+ and/or of lists of the form (TITLE QUERY COUNT), where COUNT is
+ used to generate the message count instead of QUERY. (To make
+ the customize-interface nicer, COUNT is also allowed to be nil).
+
+The following properties are valid for both :type's:
+:hide-empty - If non-nil, hide items that have no matching messages
+:position - If 'before, it will be displayed before the search input form, otherwise
+ after the recent searches.
+:hidden-on-startup - If non-nil, this section will be hidden when notmuch-hello
+ is first run."
+ :type `(repeat
+ (choice (const :tag "Show all messages for each tag"
+ ,notmuch-hello-section-all-tags)
+ (const :tag "Only unread messages for each tag"
+ ,notmuch-hello-section-unread-tags)
+ notmuch-section-type))
:group 'notmuch)
(defface notmuch-hello-logo-background
@@ -238,12 +329,32 @@ should be. Returns a cons cell `(tags-per-line width)'."
(* tags-per-line (+ 9 1))))
tags-per-line))))
-(defun notmuch-hello-insert-tags (tag-alist widest target)
+(defun notmuch-hello-get-count-query (query-item)
+ (if (consp (cdr query-item))
+ (or (third query-item) (second query-item))
+ (cdr query-item)))
+
+(defun notmuch-hello-insert-tags (tag-alist widest target &optional show-empty)
(let* ((tags-and-width (notmuch-hello-tags-per-line widest))
(tags-per-line (car tags-and-width))
+ (count-alist
+ (mapcar
+ (lambda (tag-entry)
+ (cons (car tag-entry)
+ (string-to-number (notmuch-saved-search-count
+ (notmuch-hello-get-count-query tag-entry)))))
+ tag-alist))
+ (tag-alist-filtered
+ (if show-empty
+ tag-alist
+ (notmuch-remove-if-not
+ (lambda (tag-entry)
+ ;; filter out entries that have 0 results
+ (and (not (eq 0 (cdr (assoc (car tag-entry) count-alist)))) tag-entry))
+ tag-alist)))
(widest (cdr tags-and-width))
(count 0)
- (reordered-list (notmuch-hello-reflect tag-alist tags-per-line))
+ (reordered-list (notmuch-hello-reflect tag-alist-filtered tags-per-line))
;; Hack the display of the buttons used.
(widget-push-button-prefix "")
(widget-push-button-suffix "")
@@ -254,11 +365,14 @@ should be. Returns a cons cell `(tags-per-line width)'."
;; (not elem) indicates an empty slot in the matrix.
(when elem
(let* ((name (car elem))
- (query (cdr elem))
+ (query (if (consp (cdr elem))
+ (second elem)
+ (cdr elem)))
+ (count-query (notmuch-hello-get-count-query elem))
(formatted-name (format "%s " name)))
(widget-insert (format "%8s "
(notmuch-hello-nice-number
- (string-to-number (notmuch-saved-search-count query)))))
+ (cdr (assoc name count-alist)))))
(if (string= formatted-name target)
(setq found-target-pos (point-marker)))
(widget-create 'push-button
@@ -338,24 +452,92 @@ 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")))))
+(defun notmuch-hello-section-tag-to-title (section tag)
+ (let ((make-title (plist-get section :make-title)))
+ (if make-title
+ (funcall make-title tag)
+ tag)))
+
+(defun notmuch-hello-section-get-widest (section)
+ "Return widest title string in SECTION."
+ (case (plist-get section :type)
+ ('eachtag (apply #'max
+ (mapcar (lambda (tag)
+ (length (notmuch-hello-section-tag-to-title section tag)))
+ (notmuch-all-tags))))
+ ('query-list (apply #'max
+ (mapcar (lambda (entry) (length (first entry)))
+ (plist-get section :items))))
+ (t (message (concat "Unknown section type: "
+ (prin1-to-string (plist-get section :type)))))))
+
+(defun notmuch-hello-generate-tag-alist (section)
+ "Generate an alist of tags as expected by notmuch-insert-tags for SECTION.
+
+This function handles the special case that section is of type 'eachtag"
+ (let ((make-tag (lambda (make-entry tag)
+ (cond
+ ((functionp make-entry)
+ (let ((query (funcall make-entry tag)))
+ (and query
+ (concat "tag:" tag " and (" query ")"))))
+ ((stringp make-entry)
+ (concat "tag:" tag " and (" make-entry ")"))
+ (t (concat "tag:" tag))))))
+ ;; remove tags for which make-query returned nil
+ (delq nil
+ (mapcar (lambda (tag)
+ (let ((title
+ (notmuch-hello-section-tag-to-title section tag))
+ (query (funcall make-tag
+ (plist-get section :make-query) tag))
+ (count (plist-get section :make-count)))
+ (and query
+ (if count
+ (list title query (funcall make-tag count tag))
+ (cons title query)))))
+ ;; remove tags from :hide-tags
+ (notmuch-remove-if-not
+ (lambda (tag)
+ (not (member tag (plist-get section :hide-tags))))
+ (notmuch-all-tags))))))
+
+(defun notmuch-hello-section-to-alist (section)
+ "Generate an alist of tags as expected by notmuch-insert-tags for SECTION."
+ (case (plist-get section :type)
+ ('eachtag (notmuch-hello-generate-tag-alist section))
+ ('query-list (plist-get section :items))
+ (t (message (concat "Unknown section type: "
+ (prin1-to-string (plist-get section :type)))))))
+
+
+(defun notmuch-hello-insert-section (section widest target)
+"Insert all UI elements for SECTION in the current buffer."
+ (let* ((tags-alist (notmuch-hello-section-to-alist section))
+ (title (plist-get section :title))
+ (hidden (member title notmuch-hello-hidden-sections))
+ (hide-empty (plist-get section :hide-empty))
+ target-pos)
+ (widget-insert (concat "\n" title " "))
+ (when hidden
+ (widget-create 'push-button
+ :notify `(lambda (widget &rest ignore)
+ (setq notmuch-hello-hidden-sections
+ (delq ,title notmuch-hello-hidden-sections))
+ (notmuch-hello-update))
+ "show"))
+ (when (not hidden)
+ (widget-create 'push-button
+ :notify `(lambda (widget &rest ignore)
+ (add-to-list 'notmuch-hello-hidden-sections ,title)
+ (notmuch-hello-update))
+ "hide")
+ (widget-insert "\n\n")
+ (let ((start (point)))
+ (setq target-pos (notmuch-hello-insert-tags tags-alist widest target
+ (not hide-empty)))
+ (indent-rigidly start (point) notmuch-hello-indent))
+ target-pos)))
;;;###autoload
(defun notmuch-hello (&optional no-display)
@@ -426,7 +608,30 @@ Complete list of currently available key bindings:
(widget-insert " messages.\n"))
(let ((found-target-pos nil)
- (final-target-pos nil))
+ (final-target-pos nil)
+ (upper-sections (notmuch-remove-if-not
+ (lambda (section) (eq (plist-get section :position)
+ 'before))
+ notmuch-hello-sections))
+ (lower-sections (notmuch-remove-if-not
+ (lambda (section) (not (eq (plist-get section :position)
+ 'before)))
+ notmuch-hello-sections)))
+
+ ;; handle sections that should be hidden initially
+ (when notmuch-hello-first-run
+ (mapc (lambda (section)
+ (if (plist-get section :hidden-on-startup)
+ (add-to-list 'notmuch-hello-hidden-sections
+ (plist-get section :title))))
+ notmuch-hello-sections)
+ ;; special case for notmuch-show-all-tags-list
+ (when (and (not notmuch-show-all-tags-list)
+ (member notmuch-hello-section-all-tags notmuch-hello-sections))
+ (add-to-list 'notmuch-hello-hidden-sections
+ (plist-get notmuch-hello-section-all-tags :title)))
+ (setq notmuch-hello-first-run nil))
+
(let* ((saved-alist
;; Filter out empty saved seaches if required.
(if notmuch-show-empty-saved-searches
@@ -435,9 +640,9 @@ 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 (notmuch-hello-generate-tag-alist)))
- (alltags-widest (notmuch-hello-longest-label alltags-alist))
- (widest (max saved-widest alltags-widest)))
+ (sections-widest (apply #'max (mapcar #'notmuch-hello-section-get-widest
+ notmuch-hello-sections)))
+ (widest (max saved-widest sections-widest)))
(when saved-alist
(widget-insert "\nSaved searches: ")
@@ -453,6 +658,13 @@ Complete list of currently available key bindings:
(setq final-target-pos found-target-pos))
(indent-rigidly start (point) notmuch-hello-indent)))
+ (mapc (lambda (section)
+ (setq found-target-pos
+ (notmuch-hello-insert-section section widest target))
+ (unless final-target-pos
+ (setq final-target-pos found-target-pos)))
+ upper-sections)
+
(widget-insert "\nSearch: ")
(setq notmuch-hello-search-bar-marker (point-marker))
(widget-create 'editable-field
@@ -507,28 +719,12 @@ Complete list of currently available key bindings:
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)
- (widget-create 'push-button
- :notify (lambda (widget &rest ignore)
- (setq notmuch-show-all-tags-list t)
- (notmuch-hello-update))
- "Show all tags")))
+ (mapc (lambda (section)
+ (setq found-target-pos
+ (notmuch-hello-insert-section section widest target))
+ (unless final-target-pos
+ (setq final-target-pos found-target-pos)))
+ lower-sections))
(let ((start (point)))
(widget-insert "\n\n")
diff --git a/emacs/notmuch-lib.el b/emacs/notmuch-lib.el
index d5ca0f4..615abad 100644
--- a/emacs/notmuch-lib.el
+++ b/emacs/notmuch-lib.el
@@ -103,6 +103,19 @@ the user hasn't set this variable with the old or new value."
(kill-new text)
(message "Stashed: %s" text))
+(defun notmuch-all-tags ()
+ "Return a list of all tags in the database"
+ (process-lines "notmuch" "search-tags"))
+
+(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)))
+
;;
;; XXX: This should be a generic function in emacs somewhere, not
@@ -120,15 +133,6 @@ 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
--
1.7.5.1
[-- Attachment #2: Type: application/pgp-signature, Size: 835 bytes --]
^ permalink raw reply related [flat|nested] 5+ messages in thread
* Re: [PATCH] emacs: User-defined sections in notmuch-hello
2011-05-27 21:41 ` Daniel Schoepe
@ 2011-05-27 21:51 ` Daniel Schoepe
0 siblings, 0 replies; 5+ messages in thread
From: Daniel Schoepe @ 2011-05-27 21:51 UTC (permalink / raw)
To: notmuch
[-- Attachment #1.1: Type: text/plain, Size: 63 bytes --]
Accidentally attached the old file again, sorry for the noise.
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #1.2: 0001-emacs-User-defined-sections-in-notmuch-hello.patch --]
[-- Type: text/x-diff, Size: 20614 bytes --]
From cafc93e3364955cab70885fec740fee87bc3248e Mon Sep 17 00:00:00 2001
From: Daniel Schoepe <daniel.schoepe@googlemail.com>
Date: Thu, 26 May 2011 23:03:22 +0200
Subject: [PATCH] emacs: User-defined sections in notmuch-hello
This patch allows the user to define various sections that will
be displayed in notmuch-hello. I tried to keep the section
description flexible, so it allows different queries for the
tag buttons and the counts next to them, as well as hiding items
with zero results.
The sections are (hopefully) fully editable using customize.
I have not yet rewritten the saved-searches portion using this
mechanism, to avoid breaking the configurations of many users.
---
emacs/notmuch-hello.el | 333 ++++++++++++++++----
emacs/notmuch-lib.el | 22 +-
test/emacs.expected-output/notmuch-hello | 2 +-
.../notmuch-hello-no-saved-searches | 2 +-
.../emacs.expected-output/notmuch-hello-with-empty | 2 +-
5 files changed, 282 insertions(+), 79 deletions(-)
diff --git a/emacs/notmuch-hello.el b/emacs/notmuch-hello.el
index 916cda1..f014357 100644
--- a/emacs/notmuch-hello.el
+++ b/emacs/notmuch-hello.el
@@ -55,24 +55,115 @@
: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)
+(defvar notmuch-hello-section-all-tags
+ (list :title "All tags:"
+ :type 'eachtag)
+ "Default section definition for the \"all tags\" section.")
+
+(defvar notmuch-hello-section-unread-tags
+ (list :title "All tags, unread only:"
+ :type 'eachtag
+ :make-query "tag:unread")
+ "Show and count only unread messages for each tag.")
+
+(defvar notmuch-hello-hidden-sections nil
+ "Sections that are hidden in notmuch-hello")
+
+(defvar notmuch-hello-first-run t
+ "Internal variable for hiding sections with :hidden-on-startup")
+
+(define-widget 'notmuch-section-query-type 'lazy
+ "Customize-type for query items"
+ :tag "Query item"
+ :type '(list (string :tag "Search title")
+ (string :tag "Query to use")
+ (choice :tag "Query for message count"
+ (const :tag "Use previous query" nil)
+ (string :tag "Different query"))))
+
+(define-widget 'notmuch-section-make-query-type 'lazy
+ "Customize-type for query functions"
+ :tag "Query function"
+ :type '(choice (const :tag "All messages with tag" nil)
+ (const :tag "Only unread messages" "tag:unread")
+ (string :tag "Custom filter string")
+ (function :tag "Custom filter function")))
+
+(define-widget 'notmuch-section-type 'lazy
+ "Customize-type for sections"
+ :tag "Custom section"
+ :type
+ '(plist :options (((const :tag "Title for this section" :title)
+ string)
+ ((const :tag "Type of this section" :type)
+ (choice (const :tag "One item for each tag"
+ eachtag)
+ (const :tag "Custom list of searches"
+ query-list)))
+ ((const :tag "Function to generate a query, ignored if custom list"
+ :make-query)
+ notmuch-section-make-query)
+ ((const :tag "Function to generate counts, ignored if custom list"
+ :make-count)
+ notmuch-section-make-query)
+ ((const :tag "Function to create titles for tag entries, ignored if custom list"
+ :make-title)
+ (choice (const :tag "The tag itself" nil)
+ (function :tag "Custom function")))
+ ((const :tag "List of tags to hide, ignored if custom list"
+ :hide-tags)
+ (repeat (string :tag "tag")))
+ ((const :tag "Search queries, only used if custom list"
+ :items)
+ (repeat notmuch-section-query))
+ ((const :tag "Hide if there are no results" :hide-empty)
+ boolean)
+ ((const :tag "Where should this be positioned" :position)
+ (choice (const :tag "Before the search input" before)
+ (const :tag "After the search input" after))))))
+
+(defcustom notmuch-hello-sections (list notmuch-hello-section-all-tags)
+ "Sections to be displayed in notmuch-hello.
+
+This variable does not include the saved-searches section, which
+is handled separately.
+This variable should be a list of plists with the following
+possible properties:
+
+:title - The title of the section
+:type - Can be 'eachtag or 'query-list, If 'eachtag, generate one
+ item for each tag, otherwise use a fixed set of items.
+The following options are only used when type is 'eachtag:
+:make-query - This can be a query string that is used as a filter for all
+ messages that contain this tag. This can also be a function
+ that is given is tag and should return a filter query. If
+ it returns nil, the tag will be hidden. If nil, all
+ messages having the tag will be used.
+:make-count - Query used to generate message counts next to the labels,
+ same type as :make-query. If this is nil, the same query as
+ above will be used.
+:make-title - Function to generate an alternative title for each tag item.
+ Can be nil.
+:hide-tags - List of tags that will be hidden.
+
+If :type is 'query-list, the following entry must be set:
+:items - List of cons-cells of a title and a query for that item,
+ and/or of lists of the form (TITLE QUERY COUNT), where COUNT is
+ used to generate the message count instead of QUERY. (To make
+ the customize-interface nicer, COUNT is also allowed to be nil).
+
+The following properties are valid for both :type's:
+:hide-empty - If non-nil, hide items that have no matching messages
+:position - If 'before, it will be displayed before the search input form, otherwise
+ after the recent searches.
+:hidden-on-startup - If non-nil, this section will be hidden when notmuch-hello
+ is first run."
+ :type `(repeat
+ (choice (const :tag "Show all messages for each tag"
+ ,notmuch-hello-section-all-tags)
+ (const :tag "Only unread messages for each tag"
+ ,notmuch-hello-section-unread-tags)
+ notmuch-section-type))
:group 'notmuch)
(defface notmuch-hello-logo-background
@@ -238,12 +329,32 @@ should be. Returns a cons cell `(tags-per-line width)'."
(* tags-per-line (+ 9 1))))
tags-per-line))))
-(defun notmuch-hello-insert-tags (tag-alist widest target)
+(defun notmuch-hello-get-count-query (query-item)
+ (if (consp (cdr query-item))
+ (or (third query-item) (second query-item))
+ (cdr query-item)))
+
+(defun notmuch-hello-insert-tags (tag-alist widest target &optional show-empty)
(let* ((tags-and-width (notmuch-hello-tags-per-line widest))
(tags-per-line (car tags-and-width))
+ (count-alist
+ (mapcar
+ (lambda (tag-entry)
+ (cons (car tag-entry)
+ (string-to-number (notmuch-saved-search-count
+ (notmuch-hello-get-count-query tag-entry)))))
+ tag-alist))
+ (tag-alist-filtered
+ (if show-empty
+ tag-alist
+ (notmuch-remove-if-not
+ (lambda (tag-entry)
+ ;; filter out entries that have 0 results
+ (and (not (eq 0 (cdr (assoc (car tag-entry) count-alist)))) tag-entry))
+ tag-alist)))
(widest (cdr tags-and-width))
(count 0)
- (reordered-list (notmuch-hello-reflect tag-alist tags-per-line))
+ (reordered-list (notmuch-hello-reflect tag-alist-filtered tags-per-line))
;; Hack the display of the buttons used.
(widget-push-button-prefix "")
(widget-push-button-suffix "")
@@ -254,11 +365,14 @@ should be. Returns a cons cell `(tags-per-line width)'."
;; (not elem) indicates an empty slot in the matrix.
(when elem
(let* ((name (car elem))
- (query (cdr elem))
+ (query (if (consp (cdr elem))
+ (second elem)
+ (cdr elem)))
+ (count-query (notmuch-hello-get-count-query elem))
(formatted-name (format "%s " name)))
(widget-insert (format "%8s "
(notmuch-hello-nice-number
- (string-to-number (notmuch-saved-search-count query)))))
+ (cdr (assoc name count-alist)))))
(if (string= formatted-name target)
(setq found-target-pos (point-marker)))
(widget-create 'push-button
@@ -338,24 +452,94 @@ 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")))))
+(defun notmuch-hello-section-tag-to-title (section tag)
+ (let ((make-title (plist-get section :make-title)))
+ (if make-title
+ (funcall make-title tag)
+ tag)))
+
+(defun notmuch-hello-section-get-widest (section)
+ "Return widest title string in SECTION."
+ (if (member (plist-get section :title) notmuch-hello-hidden-sections)
+ 0
+ (case (plist-get section :type)
+ ('eachtag (apply #'max
+ (mapcar (lambda (tag)
+ (length (notmuch-hello-section-tag-to-title section tag)))
+ (notmuch-all-tags))))
+ ('query-list (apply #'max
+ (mapcar (lambda (entry) (length (first entry)))
+ (plist-get section :items))))
+ (t (message (concat "Unknown section type: "
+ (prin1-to-string (plist-get section :type))))))))
+
+(defun notmuch-hello-generate-tag-alist (section)
+ "Generate an alist of tags as expected by notmuch-insert-tags for SECTION.
+
+This function handles the special case that section is of type 'eachtag"
+ (let ((make-tag (lambda (make-entry tag)
+ (cond
+ ((functionp make-entry)
+ (let ((query (funcall make-entry tag)))
+ (and query
+ (concat "tag:" tag " and (" query ")"))))
+ ((stringp make-entry)
+ (concat "tag:" tag " and (" make-entry ")"))
+ (t (concat "tag:" tag))))))
+ ;; remove tags for which make-query returned nil
+ (delq nil
+ (mapcar (lambda (tag)
+ (let ((title
+ (notmuch-hello-section-tag-to-title section tag))
+ (query (funcall make-tag
+ (plist-get section :make-query) tag))
+ (count (plist-get section :make-count)))
+ (and query
+ (if count
+ (list title query (funcall make-tag count tag))
+ (cons title query)))))
+ ;; remove tags from :hide-tags
+ (notmuch-remove-if-not
+ (lambda (tag)
+ (not (member tag (plist-get section :hide-tags))))
+ (notmuch-all-tags))))))
+
+(defun notmuch-hello-section-to-alist (section)
+ "Generate an alist of tags as expected by notmuch-insert-tags for SECTION."
+ (case (plist-get section :type)
+ ('eachtag (notmuch-hello-generate-tag-alist section))
+ ('query-list (plist-get section :items))
+ (t (message (concat "Unknown section type: "
+ (prin1-to-string (plist-get section :type)))))))
+
+
+(defun notmuch-hello-insert-section (section widest target)
+"Insert all UI elements for SECTION in the current buffer."
+ (let* ((tags-alist (notmuch-hello-section-to-alist section))
+ (title (plist-get section :title))
+ (hidden (member title notmuch-hello-hidden-sections))
+ (hide-empty (plist-get section :hide-empty))
+ target-pos)
+ (widget-insert (concat "\n" title " "))
+ (when hidden
+ (widget-create 'push-button
+ :notify `(lambda (widget &rest ignore)
+ (setq notmuch-hello-hidden-sections
+ (delq ,title notmuch-hello-hidden-sections))
+ (notmuch-hello-update))
+ "show"))
+ (when (not hidden)
+ (widget-create 'push-button
+ :notify `(lambda (widget &rest ignore)
+ (add-to-list 'notmuch-hello-hidden-sections ,title)
+ (notmuch-hello-update))
+ "hide")
+ (widget-insert "\n\n")
+ (let ((start (point)))
+ (setq target-pos (notmuch-hello-insert-tags tags-alist widest target
+ (not hide-empty)))
+ (indent-rigidly start (point) notmuch-hello-indent))
+ target-pos)))
;;;###autoload
(defun notmuch-hello (&optional no-display)
@@ -426,7 +610,30 @@ Complete list of currently available key bindings:
(widget-insert " messages.\n"))
(let ((found-target-pos nil)
- (final-target-pos nil))
+ (final-target-pos nil)
+ (upper-sections (notmuch-remove-if-not
+ (lambda (section) (eq (plist-get section :position)
+ 'before))
+ notmuch-hello-sections))
+ (lower-sections (notmuch-remove-if-not
+ (lambda (section) (not (eq (plist-get section :position)
+ 'before)))
+ notmuch-hello-sections)))
+
+ ;; handle sections that should be hidden initially
+ (when notmuch-hello-first-run
+ (mapc (lambda (section)
+ (if (plist-get section :hidden-on-startup)
+ (add-to-list 'notmuch-hello-hidden-sections
+ (plist-get section :title))))
+ notmuch-hello-sections)
+ ;; special case for notmuch-show-all-tags-list
+ (when (and (not notmuch-show-all-tags-list)
+ (member notmuch-hello-section-all-tags notmuch-hello-sections))
+ (add-to-list 'notmuch-hello-hidden-sections
+ (plist-get notmuch-hello-section-all-tags :title)))
+ (setq notmuch-hello-first-run nil))
+
(let* ((saved-alist
;; Filter out empty saved seaches if required.
(if notmuch-show-empty-saved-searches
@@ -435,9 +642,9 @@ 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 (notmuch-hello-generate-tag-alist)))
- (alltags-widest (notmuch-hello-longest-label alltags-alist))
- (widest (max saved-widest alltags-widest)))
+ (sections-widest (apply #'max 0 (mapcar #'notmuch-hello-section-get-widest
+ notmuch-hello-sections)))
+ (widest (max saved-widest sections-widest)))
(when saved-alist
(widget-insert "\nSaved searches: ")
@@ -448,11 +655,19 @@ Complete list of currently available key bindings:
(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))
+ (setq found-target-pos (notmuch-hello-insert-tags saved-alist widest target
+ notmuch-show-empty-saved-searches))
(if found-target-pos
(setq final-target-pos found-target-pos))
(indent-rigidly start (point) notmuch-hello-indent)))
+ (mapc (lambda (section)
+ (setq found-target-pos
+ (notmuch-hello-insert-section section widest target))
+ (unless final-target-pos
+ (setq final-target-pos found-target-pos)))
+ upper-sections)
+
(widget-insert "\nSearch: ")
(setq notmuch-hello-search-bar-marker (point-marker))
(widget-create 'editable-field
@@ -507,28 +722,12 @@ Complete list of currently available key bindings:
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)
- (widget-create 'push-button
- :notify (lambda (widget &rest ignore)
- (setq notmuch-show-all-tags-list t)
- (notmuch-hello-update))
- "Show all tags")))
+ (mapc (lambda (section)
+ (setq found-target-pos
+ (notmuch-hello-insert-section section widest target))
+ (unless final-target-pos
+ (setq final-target-pos found-target-pos)))
+ lower-sections))
(let ((start (point)))
(widget-insert "\n\n")
diff --git a/emacs/notmuch-lib.el b/emacs/notmuch-lib.el
index d5ca0f4..615abad 100644
--- a/emacs/notmuch-lib.el
+++ b/emacs/notmuch-lib.el
@@ -103,6 +103,19 @@ the user hasn't set this variable with the old or new value."
(kill-new text)
(message "Stashed: %s" text))
+(defun notmuch-all-tags ()
+ "Return a list of all tags in the database"
+ (process-lines "notmuch" "search-tags"))
+
+(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)))
+
;;
;; XXX: This should be a generic function in emacs somewhere, not
@@ -120,15 +133,6 @@ 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
diff --git a/test/emacs.expected-output/notmuch-hello b/test/emacs.expected-output/notmuch-hello
index 64b7e42..f98f132 100644
--- a/test/emacs.expected-output/notmuch-hello
+++ b/test/emacs.expected-output/notmuch-hello
@@ -6,7 +6,7 @@ Saved searches: [edit]
Search:
-[Show all tags]
+All tags: [show]
Type a search query and hit RET to view matching threads.
Edit saved searches with the `edit' button.
diff --git a/test/emacs.expected-output/notmuch-hello-no-saved-searches b/test/emacs.expected-output/notmuch-hello-no-saved-searches
index 7f8206a..46172ee 100644
--- a/test/emacs.expected-output/notmuch-hello-no-saved-searches
+++ b/test/emacs.expected-output/notmuch-hello-no-saved-searches
@@ -2,7 +2,7 @@
Search:
-[Show all tags]
+All tags: [show]
Type a search query and hit RET to view matching threads.
Edit saved searches with the `edit' button.
diff --git a/test/emacs.expected-output/notmuch-hello-with-empty b/test/emacs.expected-output/notmuch-hello-with-empty
index a9ed630..eb563cc 100644
--- a/test/emacs.expected-output/notmuch-hello-with-empty
+++ b/test/emacs.expected-output/notmuch-hello-with-empty
@@ -6,7 +6,7 @@ Saved searches: [edit]
Search:
-[Show all tags]
+All tags: [show]
Type a search query and hit RET to view matching threads.
Edit saved searches with the `edit' button.
--
1.7.5.1
[-- Attachment #2: Type: application/pgp-signature, Size: 835 bytes --]
^ permalink raw reply related [flat|nested] 5+ messages in thread
* Re: [PATCH] emacs: User-defined sections in notmuch-hello
2011-05-27 18:52 [PATCH] emacs: User-defined sections in notmuch-hello Daniel Schoepe
2011-05-27 21:41 ` Daniel Schoepe
@ 2011-06-03 13:46 ` Daniel Schoepe
2011-06-10 5:42 ` Austin Clements
1 sibling, 1 reply; 5+ messages in thread
From: Daniel Schoepe @ 2011-06-03 13:46 UTC (permalink / raw)
To: notmuch
[-- Attachment #1.1: Type: text/plain, Size: 276 bytes --]
On Fri, 27 May 2011 20:52:01 +0200, Daniel Schoepe <daniel.schoepe@googlemail.com> wrote:
> I'll also work on some tests for this functionality, (if no one
> has big, structural complaints about the code).
I rebased my patch against the current master and wrote some tests.
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #1.2: 0001-emacs-User-defined-sections-in-notmuch-hello.patch --]
[-- Type: text/x-diff, Size: 20618 bytes --]
From 42b87fca9b8b2ca5ba6748185dac4e945d7c594b Mon Sep 17 00:00:00 2001
From: Daniel Schoepe <daniel.schoepe@googlemail.com>
Date: Thu, 26 May 2011 23:03:22 +0200
Subject: [PATCH 1/2] emacs: User-defined sections in notmuch-hello
This patch allows the user to define various sections that will
be displayed in notmuch-hello. I tried to keep the section
description flexible, so it allows different queries for the
tag buttons and the counts next to them, as well as hiding items
with zero results.
The sections are (hopefully) fully editable using customize.
I have not yet rewritten the saved-searches portion using this
mechanism, to avoid breaking the configurations of many users.
---
emacs/notmuch-hello.el | 333 ++++++++++++++++----
emacs/notmuch-lib.el | 22 +-
test/emacs.expected-output/notmuch-hello | 2 +-
.../notmuch-hello-no-saved-searches | 2 +-
.../emacs.expected-output/notmuch-hello-with-empty | 2 +-
5 files changed, 282 insertions(+), 79 deletions(-)
diff --git a/emacs/notmuch-hello.el b/emacs/notmuch-hello.el
index 916cda1..f014357 100644
--- a/emacs/notmuch-hello.el
+++ b/emacs/notmuch-hello.el
@@ -55,24 +55,115 @@
: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)
+(defvar notmuch-hello-section-all-tags
+ (list :title "All tags:"
+ :type 'eachtag)
+ "Default section definition for the \"all tags\" section.")
+
+(defvar notmuch-hello-section-unread-tags
+ (list :title "All tags, unread only:"
+ :type 'eachtag
+ :make-query "tag:unread")
+ "Show and count only unread messages for each tag.")
+
+(defvar notmuch-hello-hidden-sections nil
+ "Sections that are hidden in notmuch-hello")
+
+(defvar notmuch-hello-first-run t
+ "Internal variable for hiding sections with :hidden-on-startup")
+
+(define-widget 'notmuch-section-query-type 'lazy
+ "Customize-type for query items"
+ :tag "Query item"
+ :type '(list (string :tag "Search title")
+ (string :tag "Query to use")
+ (choice :tag "Query for message count"
+ (const :tag "Use previous query" nil)
+ (string :tag "Different query"))))
+
+(define-widget 'notmuch-section-make-query-type 'lazy
+ "Customize-type for query functions"
+ :tag "Query function"
+ :type '(choice (const :tag "All messages with tag" nil)
+ (const :tag "Only unread messages" "tag:unread")
+ (string :tag "Custom filter string")
+ (function :tag "Custom filter function")))
+
+(define-widget 'notmuch-section-type 'lazy
+ "Customize-type for sections"
+ :tag "Custom section"
+ :type
+ '(plist :options (((const :tag "Title for this section" :title)
+ string)
+ ((const :tag "Type of this section" :type)
+ (choice (const :tag "One item for each tag"
+ eachtag)
+ (const :tag "Custom list of searches"
+ query-list)))
+ ((const :tag "Function to generate a query, ignored if custom list"
+ :make-query)
+ notmuch-section-make-query)
+ ((const :tag "Function to generate counts, ignored if custom list"
+ :make-count)
+ notmuch-section-make-query)
+ ((const :tag "Function to create titles for tag entries, ignored if custom list"
+ :make-title)
+ (choice (const :tag "The tag itself" nil)
+ (function :tag "Custom function")))
+ ((const :tag "List of tags to hide, ignored if custom list"
+ :hide-tags)
+ (repeat (string :tag "tag")))
+ ((const :tag "Search queries, only used if custom list"
+ :items)
+ (repeat notmuch-section-query))
+ ((const :tag "Hide if there are no results" :hide-empty)
+ boolean)
+ ((const :tag "Where should this be positioned" :position)
+ (choice (const :tag "Before the search input" before)
+ (const :tag "After the search input" after))))))
+
+(defcustom notmuch-hello-sections (list notmuch-hello-section-all-tags)
+ "Sections to be displayed in notmuch-hello.
+
+This variable does not include the saved-searches section, which
+is handled separately.
+This variable should be a list of plists with the following
+possible properties:
+
+:title - The title of the section
+:type - Can be 'eachtag or 'query-list, If 'eachtag, generate one
+ item for each tag, otherwise use a fixed set of items.
+The following options are only used when type is 'eachtag:
+:make-query - This can be a query string that is used as a filter for all
+ messages that contain this tag. This can also be a function
+ that is given is tag and should return a filter query. If
+ it returns nil, the tag will be hidden. If nil, all
+ messages having the tag will be used.
+:make-count - Query used to generate message counts next to the labels,
+ same type as :make-query. If this is nil, the same query as
+ above will be used.
+:make-title - Function to generate an alternative title for each tag item.
+ Can be nil.
+:hide-tags - List of tags that will be hidden.
+
+If :type is 'query-list, the following entry must be set:
+:items - List of cons-cells of a title and a query for that item,
+ and/or of lists of the form (TITLE QUERY COUNT), where COUNT is
+ used to generate the message count instead of QUERY. (To make
+ the customize-interface nicer, COUNT is also allowed to be nil).
+
+The following properties are valid for both :type's:
+:hide-empty - If non-nil, hide items that have no matching messages
+:position - If 'before, it will be displayed before the search input form, otherwise
+ after the recent searches.
+:hidden-on-startup - If non-nil, this section will be hidden when notmuch-hello
+ is first run."
+ :type `(repeat
+ (choice (const :tag "Show all messages for each tag"
+ ,notmuch-hello-section-all-tags)
+ (const :tag "Only unread messages for each tag"
+ ,notmuch-hello-section-unread-tags)
+ notmuch-section-type))
:group 'notmuch)
(defface notmuch-hello-logo-background
@@ -238,12 +329,32 @@ should be. Returns a cons cell `(tags-per-line width)'."
(* tags-per-line (+ 9 1))))
tags-per-line))))
-(defun notmuch-hello-insert-tags (tag-alist widest target)
+(defun notmuch-hello-get-count-query (query-item)
+ (if (consp (cdr query-item))
+ (or (third query-item) (second query-item))
+ (cdr query-item)))
+
+(defun notmuch-hello-insert-tags (tag-alist widest target &optional show-empty)
(let* ((tags-and-width (notmuch-hello-tags-per-line widest))
(tags-per-line (car tags-and-width))
+ (count-alist
+ (mapcar
+ (lambda (tag-entry)
+ (cons (car tag-entry)
+ (string-to-number (notmuch-saved-search-count
+ (notmuch-hello-get-count-query tag-entry)))))
+ tag-alist))
+ (tag-alist-filtered
+ (if show-empty
+ tag-alist
+ (notmuch-remove-if-not
+ (lambda (tag-entry)
+ ;; filter out entries that have 0 results
+ (and (not (eq 0 (cdr (assoc (car tag-entry) count-alist)))) tag-entry))
+ tag-alist)))
(widest (cdr tags-and-width))
(count 0)
- (reordered-list (notmuch-hello-reflect tag-alist tags-per-line))
+ (reordered-list (notmuch-hello-reflect tag-alist-filtered tags-per-line))
;; Hack the display of the buttons used.
(widget-push-button-prefix "")
(widget-push-button-suffix "")
@@ -254,11 +365,14 @@ should be. Returns a cons cell `(tags-per-line width)'."
;; (not elem) indicates an empty slot in the matrix.
(when elem
(let* ((name (car elem))
- (query (cdr elem))
+ (query (if (consp (cdr elem))
+ (second elem)
+ (cdr elem)))
+ (count-query (notmuch-hello-get-count-query elem))
(formatted-name (format "%s " name)))
(widget-insert (format "%8s "
(notmuch-hello-nice-number
- (string-to-number (notmuch-saved-search-count query)))))
+ (cdr (assoc name count-alist)))))
(if (string= formatted-name target)
(setq found-target-pos (point-marker)))
(widget-create 'push-button
@@ -338,24 +452,94 @@ 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")))))
+(defun notmuch-hello-section-tag-to-title (section tag)
+ (let ((make-title (plist-get section :make-title)))
+ (if make-title
+ (funcall make-title tag)
+ tag)))
+
+(defun notmuch-hello-section-get-widest (section)
+ "Return widest title string in SECTION."
+ (if (member (plist-get section :title) notmuch-hello-hidden-sections)
+ 0
+ (case (plist-get section :type)
+ ('eachtag (apply #'max
+ (mapcar (lambda (tag)
+ (length (notmuch-hello-section-tag-to-title section tag)))
+ (notmuch-all-tags))))
+ ('query-list (apply #'max
+ (mapcar (lambda (entry) (length (first entry)))
+ (plist-get section :items))))
+ (t (message (concat "Unknown section type: "
+ (prin1-to-string (plist-get section :type))))))))
+
+(defun notmuch-hello-generate-tag-alist (section)
+ "Generate an alist of tags as expected by notmuch-insert-tags for SECTION.
+
+This function handles the special case that section is of type 'eachtag"
+ (let ((make-tag (lambda (make-entry tag)
+ (cond
+ ((functionp make-entry)
+ (let ((query (funcall make-entry tag)))
+ (and query
+ (concat "tag:" tag " and (" query ")"))))
+ ((stringp make-entry)
+ (concat "tag:" tag " and (" make-entry ")"))
+ (t (concat "tag:" tag))))))
+ ;; remove tags for which make-query returned nil
+ (delq nil
+ (mapcar (lambda (tag)
+ (let ((title
+ (notmuch-hello-section-tag-to-title section tag))
+ (query (funcall make-tag
+ (plist-get section :make-query) tag))
+ (count (plist-get section :make-count)))
+ (and query
+ (if count
+ (list title query (funcall make-tag count tag))
+ (cons title query)))))
+ ;; remove tags from :hide-tags
+ (notmuch-remove-if-not
+ (lambda (tag)
+ (not (member tag (plist-get section :hide-tags))))
+ (notmuch-all-tags))))))
+
+(defun notmuch-hello-section-to-alist (section)
+ "Generate an alist of tags as expected by notmuch-insert-tags for SECTION."
+ (case (plist-get section :type)
+ ('eachtag (notmuch-hello-generate-tag-alist section))
+ ('query-list (plist-get section :items))
+ (t (message (concat "Unknown section type: "
+ (prin1-to-string (plist-get section :type)))))))
+
+
+(defun notmuch-hello-insert-section (section widest target)
+"Insert all UI elements for SECTION in the current buffer."
+ (let* ((tags-alist (notmuch-hello-section-to-alist section))
+ (title (plist-get section :title))
+ (hidden (member title notmuch-hello-hidden-sections))
+ (hide-empty (plist-get section :hide-empty))
+ target-pos)
+ (widget-insert (concat "\n" title " "))
+ (when hidden
+ (widget-create 'push-button
+ :notify `(lambda (widget &rest ignore)
+ (setq notmuch-hello-hidden-sections
+ (delq ,title notmuch-hello-hidden-sections))
+ (notmuch-hello-update))
+ "show"))
+ (when (not hidden)
+ (widget-create 'push-button
+ :notify `(lambda (widget &rest ignore)
+ (add-to-list 'notmuch-hello-hidden-sections ,title)
+ (notmuch-hello-update))
+ "hide")
+ (widget-insert "\n\n")
+ (let ((start (point)))
+ (setq target-pos (notmuch-hello-insert-tags tags-alist widest target
+ (not hide-empty)))
+ (indent-rigidly start (point) notmuch-hello-indent))
+ target-pos)))
;;;###autoload
(defun notmuch-hello (&optional no-display)
@@ -426,7 +610,30 @@ Complete list of currently available key bindings:
(widget-insert " messages.\n"))
(let ((found-target-pos nil)
- (final-target-pos nil))
+ (final-target-pos nil)
+ (upper-sections (notmuch-remove-if-not
+ (lambda (section) (eq (plist-get section :position)
+ 'before))
+ notmuch-hello-sections))
+ (lower-sections (notmuch-remove-if-not
+ (lambda (section) (not (eq (plist-get section :position)
+ 'before)))
+ notmuch-hello-sections)))
+
+ ;; handle sections that should be hidden initially
+ (when notmuch-hello-first-run
+ (mapc (lambda (section)
+ (if (plist-get section :hidden-on-startup)
+ (add-to-list 'notmuch-hello-hidden-sections
+ (plist-get section :title))))
+ notmuch-hello-sections)
+ ;; special case for notmuch-show-all-tags-list
+ (when (and (not notmuch-show-all-tags-list)
+ (member notmuch-hello-section-all-tags notmuch-hello-sections))
+ (add-to-list 'notmuch-hello-hidden-sections
+ (plist-get notmuch-hello-section-all-tags :title)))
+ (setq notmuch-hello-first-run nil))
+
(let* ((saved-alist
;; Filter out empty saved seaches if required.
(if notmuch-show-empty-saved-searches
@@ -435,9 +642,9 @@ 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 (notmuch-hello-generate-tag-alist)))
- (alltags-widest (notmuch-hello-longest-label alltags-alist))
- (widest (max saved-widest alltags-widest)))
+ (sections-widest (apply #'max 0 (mapcar #'notmuch-hello-section-get-widest
+ notmuch-hello-sections)))
+ (widest (max saved-widest sections-widest)))
(when saved-alist
(widget-insert "\nSaved searches: ")
@@ -448,11 +655,19 @@ Complete list of currently available key bindings:
(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))
+ (setq found-target-pos (notmuch-hello-insert-tags saved-alist widest target
+ notmuch-show-empty-saved-searches))
(if found-target-pos
(setq final-target-pos found-target-pos))
(indent-rigidly start (point) notmuch-hello-indent)))
+ (mapc (lambda (section)
+ (setq found-target-pos
+ (notmuch-hello-insert-section section widest target))
+ (unless final-target-pos
+ (setq final-target-pos found-target-pos)))
+ upper-sections)
+
(widget-insert "\nSearch: ")
(setq notmuch-hello-search-bar-marker (point-marker))
(widget-create 'editable-field
@@ -507,28 +722,12 @@ Complete list of currently available key bindings:
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)
- (widget-create 'push-button
- :notify (lambda (widget &rest ignore)
- (setq notmuch-show-all-tags-list t)
- (notmuch-hello-update))
- "Show all tags")))
+ (mapc (lambda (section)
+ (setq found-target-pos
+ (notmuch-hello-insert-section section widest target))
+ (unless final-target-pos
+ (setq final-target-pos found-target-pos)))
+ lower-sections))
(let ((start (point)))
(widget-insert "\n\n")
diff --git a/emacs/notmuch-lib.el b/emacs/notmuch-lib.el
index a21dc14..bc46334 100644
--- a/emacs/notmuch-lib.el
+++ b/emacs/notmuch-lib.el
@@ -103,6 +103,19 @@ the user hasn't set this variable with the old or new value."
(kill-new text)
(message "Stashed: %s" text))
+(defun notmuch-all-tags ()
+ "Return a list of all tags in the database"
+ (process-lines "notmuch" "search-tags"))
+
+(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)))
+
;;
;; XXX: This should be a generic function in emacs somewhere, not
@@ -120,15 +133,6 @@ 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
diff --git a/test/emacs.expected-output/notmuch-hello b/test/emacs.expected-output/notmuch-hello
index 64b7e42..f98f132 100644
--- a/test/emacs.expected-output/notmuch-hello
+++ b/test/emacs.expected-output/notmuch-hello
@@ -6,7 +6,7 @@ Saved searches: [edit]
Search:
-[Show all tags]
+All tags: [show]
Type a search query and hit RET to view matching threads.
Edit saved searches with the `edit' button.
diff --git a/test/emacs.expected-output/notmuch-hello-no-saved-searches b/test/emacs.expected-output/notmuch-hello-no-saved-searches
index 7f8206a..46172ee 100644
--- a/test/emacs.expected-output/notmuch-hello-no-saved-searches
+++ b/test/emacs.expected-output/notmuch-hello-no-saved-searches
@@ -2,7 +2,7 @@
Search:
-[Show all tags]
+All tags: [show]
Type a search query and hit RET to view matching threads.
Edit saved searches with the `edit' button.
diff --git a/test/emacs.expected-output/notmuch-hello-with-empty b/test/emacs.expected-output/notmuch-hello-with-empty
index a9ed630..eb563cc 100644
--- a/test/emacs.expected-output/notmuch-hello-with-empty
+++ b/test/emacs.expected-output/notmuch-hello-with-empty
@@ -6,7 +6,7 @@ Saved searches: [edit]
Search:
-[Show all tags]
+All tags: [show]
Type a search query and hit RET to view matching threads.
Edit saved searches with the `edit' button.
--
1.7.5.3
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #1.3: 0002-emacs-A-few-tests-for-user-defined-sections.patch --]
[-- Type: text/x-diff, Size: 7737 bytes --]
From 5a401e74359eafa9e6fc83c19051402270cb3662 Mon Sep 17 00:00:00 2001
From: Daniel Schoepe <daniel.schoepe@googlemail.com>
Date: Fri, 3 Jun 2011 15:42:35 +0200
Subject: [PATCH 2/2] emacs: A few tests for user-defined sections
---
test/emacs | 29 ++++++++++++++++++++
.../notmuch-hello-new-section | 17 +++++++++++
.../notmuch-hello-section-before | 18 ++++++++++++
.../notmuch-hello-section-counts | 18 ++++++++++++
.../notmuch-hello-section-hidden-tag | 17 +++++++++++
.../notmuch-hello-section-with-empty | 17 +++++++++++
6 files changed, 116 insertions(+), 0 deletions(-)
create mode 100644 test/emacs.expected-output/notmuch-hello-new-section
create mode 100644 test/emacs.expected-output/notmuch-hello-section-before
create mode 100644 test/emacs.expected-output/notmuch-hello-section-counts
create mode 100644 test/emacs.expected-output/notmuch-hello-section-hidden-tag
create mode 100644 test/emacs.expected-output/notmuch-hello-section-with-empty
diff --git a/test/emacs b/test/emacs
index 792492f..7fea4ea 100755
--- a/test/emacs
+++ b/test/emacs
@@ -31,6 +31,35 @@ output=$(test_emacs '(notmuch-hello) (goto-char (point-min)) (re-search-forward
expected=$(cat $EXPECTED/notmuch-hello-view-inbox)
test_expect_equal "$output" "$expected"
+test_begin_subtest "User defined section with inbox tag"
+output=$(test_emacs "(setq notmuch-hello-sections '((:title \"Test:\" :type query-list :items ((\"inbox\" . \"tag:inbox\"))))) (notmuch-hello) (princ (buffer-string))")
+expected=$(cat $EXPECTED/notmuch-hello-new-section)
+test_expect_equal "$output" "$expected"
+
+test_begin_subtest "User defined section with empty, hidden entry"
+output=$(test_emacs "(setq notmuch-hello-sections '((:title \"Test-with-empty:\" :type query-list :items
+ ((\"inbox\" . \"tag:inbox\") (\"doesnotexist\" . \"tag:doesnotexist\"))
+ :hide-empty t)))
+ (notmuch-hello)
+ (princ (buffer-string))")
+expected=$(cat $EXPECTED/notmuch-hello-section-with-empty)
+test_expect_equal "$output" "$expected"
+
+test_begin_subtest "User defined section, unread tag filtered out"
+output=$(test_emacs "(setq notmuch-hello-sections '((:title \"Test-with-filtered:\" :type eachtag :hide-tags (\"unread\")))) (notmuch-hello) (princ (buffer-string))")
+expected=$(cat $EXPECTED/notmuch-hello-section-hidden-tag)
+test_expect_equal "$output" "$expected"
+
+test_begin_subtest "User defined section, different query for counts"
+output=$(test_emacs "(setq notmuch-hello-sections '((:title \"Test-with-counts:\" :type eachtag :make-count \"tag:signed\"))) (notmuch-hello) (princ (buffer-string))")
+expected=$(cat $EXPECTED/notmuch-hello-section-counts)
+test_expect_equal "$output" "$expected"
+
+test_begin_subtest "User defined section, positioned before search input"
+output=$(test_emacs "(setq notmuch-hello-sections '((:title \"Test-before\" :type eachtag :position before))) (notmuch-hello) (princ (buffer-string))")
+expected=$(cat $EXPECTED/notmuch-hello-section-before)
+test_expect_equal "$output" "$expected"
+
test_begin_subtest "Basic notmuch-show view in emacs"
maildir_storage_thread=$(notmuch search --output=threads id:20091117190054.GU3165@dottiness.seas.harvard.edu)
output=$(test_emacs "(notmuch-show \"$maildir_storage_thread\") (princ (buffer-string))")
diff --git a/test/emacs.expected-output/notmuch-hello-new-section b/test/emacs.expected-output/notmuch-hello-new-section
new file mode 100644
index 0000000..23e0068
--- /dev/null
+++ b/test/emacs.expected-output/notmuch-hello-new-section
@@ -0,0 +1,17 @@
+ Welcome to notmuch. You have 50 messages.
+
+Saved searches: [edit]
+
+ 50 inbox 50 unread
+
+Search:
+
+Test: [hide]
+
+ 50 inbox
+
+
+ Type a search query and hit RET to view matching threads.
+ Edit saved searches with the `edit' button.
+ Hit RET or click on a saved search or tag name to view matching threads.
+ `=' refreshes this screen. `s' jumps to the search box. `q' to quit.
diff --git a/test/emacs.expected-output/notmuch-hello-section-before b/test/emacs.expected-output/notmuch-hello-section-before
new file mode 100644
index 0000000..a5781ce
--- /dev/null
+++ b/test/emacs.expected-output/notmuch-hello-section-before
@@ -0,0 +1,18 @@
+ Welcome to notmuch. You have 50 messages.
+
+Saved searches: [edit]
+
+ 50 inbox 50 unread
+
+Test-before [hide]
+
+ 4 attachment 7 signed
+ 50 inbox 50 unread
+
+Search:
+
+
+ Type a search query and hit RET to view matching threads.
+ Edit saved searches with the `edit' button.
+ Hit RET or click on a saved search or tag name to view matching threads.
+ `=' refreshes this screen. `s' jumps to the search box. `q' to quit.
diff --git a/test/emacs.expected-output/notmuch-hello-section-counts b/test/emacs.expected-output/notmuch-hello-section-counts
new file mode 100644
index 0000000..c22d491
--- /dev/null
+++ b/test/emacs.expected-output/notmuch-hello-section-counts
@@ -0,0 +1,18 @@
+ Welcome to notmuch. You have 50 messages.
+
+Saved searches: [edit]
+
+ 50 inbox 50 unread
+
+Search:
+
+Test-with-counts: [hide]
+
+ 2 attachment 7 signed
+ 7 inbox 7 unread
+
+
+ Type a search query and hit RET to view matching threads.
+ Edit saved searches with the `edit' button.
+ Hit RET or click on a saved search or tag name to view matching threads.
+ `=' refreshes this screen. `s' jumps to the search box. `q' to quit.
diff --git a/test/emacs.expected-output/notmuch-hello-section-hidden-tag b/test/emacs.expected-output/notmuch-hello-section-hidden-tag
new file mode 100644
index 0000000..d6d31b3
--- /dev/null
+++ b/test/emacs.expected-output/notmuch-hello-section-hidden-tag
@@ -0,0 +1,17 @@
+ Welcome to notmuch. You have 50 messages.
+
+Saved searches: [edit]
+
+ 50 inbox 50 unread
+
+Search:
+
+Test-with-filtered: [hide]
+
+ 4 attachment 50 inbox 7 signed
+
+
+ Type a search query and hit RET to view matching threads.
+ Edit saved searches with the `edit' button.
+ Hit RET or click on a saved search or tag name to view matching threads.
+ `=' refreshes this screen. `s' jumps to the search box. `q' to quit.
diff --git a/test/emacs.expected-output/notmuch-hello-section-with-empty b/test/emacs.expected-output/notmuch-hello-section-with-empty
new file mode 100644
index 0000000..7ab80f2
--- /dev/null
+++ b/test/emacs.expected-output/notmuch-hello-section-with-empty
@@ -0,0 +1,17 @@
+ Welcome to notmuch. You have 50 messages.
+
+Saved searches: [edit]
+
+ 50 inbox 50 unread
+
+Search:
+
+Test-with-empty: [hide]
+
+ 50 inbox
+
+
+ Type a search query and hit RET to view matching threads.
+ Edit saved searches with the `edit' button.
+ Hit RET or click on a saved search or tag name to view matching threads.
+ `=' refreshes this screen. `s' jumps to the search box. `q' to quit.
--
1.7.5.3
[-- Attachment #2: Type: application/pgp-signature, Size: 835 bytes --]
^ permalink raw reply related [flat|nested] 5+ messages in thread
* Re: [PATCH] emacs: User-defined sections in notmuch-hello
2011-06-03 13:46 ` Daniel Schoepe
@ 2011-06-10 5:42 ` Austin Clements
0 siblings, 0 replies; 5+ messages in thread
From: Austin Clements @ 2011-06-10 5:42 UTC (permalink / raw)
To: Daniel Schoepe; +Cc: notmuch
This looks really interesting.
I haven't examined the code very closely, but I have some high level comments.
It seems that the code is simultaneously trying to do something very
general, but also hard-coding a lot of behaviors, and I think the
code's complexity suffers for it. What would this look like if the
*entire* hello screen were replaced by a configurable list of
sections? What I'm imagining could be as simple as a list of
section-generating functions plus a collection of standard functions
for generating standard sections (probably known to customize to make
it easy for non-elispers to control).
For more-configurable sections, there could be a mechanism for passing
arguments, but this quickly enters the land of hair-raising defcustoms
and confusing flexibility. I think it would be much simpler and more
user-friendly to require the functions in this list to take no
arguments (at least, none that are user-configurable). Flexible
sections could be implemented then as a low-level function that takes
arguments and one or more no-argument high-level functions that call
the low-level section generator either with fixed arguments, or with
the values of other customize variables. This would keep things
simple and fairly flexible for non-elispers, without sacrificing
complete flexibility if you're willing to write a few lines of elisp.
Maybe you also want to configure the title of each section. But, IMO,
this is also confusing flexibility. In fact, with the no-argument
section generators, it would make a lot of sense to simply put the
section name in the function's plist.
This wouldn't fit well with the current logic to compute the
cross-section widest tag, but personally I've always found that
behavior extremely confusing (not to mention buggy) and wouldn't miss
it at all.
The use of the term "title" for pretty-printed tags is confusing. To
me, "title" means the section title. For example, I couldn't figure
out what "Return widest title string in SECTION." meant until I read
the code (*flashback* "a section only has one title, what the heck is
the widest one?")
This patch should probably be split into a few patches, as it seems to
also introduce new functionality for some of the sections (and does
little things like moving notmuch-remove-if-not).
On Fri, Jun 3, 2011 at 9:46 AM, Daniel Schoepe
<daniel.schoepe@googlemail.com> wrote:
> On Fri, 27 May 2011 20:52:01 +0200, Daniel Schoepe <daniel.schoepe@googlemail.com> wrote:
>> I'll also work on some tests for this functionality, (if no one
>> has big, structural complaints about the code).
>
> I rebased my patch against the current master and wrote some tests.
^ permalink raw reply [flat|nested] 5+ messages in thread
end of thread, other threads:[~2011-06-10 5:42 UTC | newest]
Thread overview: 5+ messages (download: mbox.gz follow: Atom feed
-- links below jump to the message on this page --
2011-05-27 18:52 [PATCH] emacs: User-defined sections in notmuch-hello Daniel Schoepe
2011-05-27 21:41 ` Daniel Schoepe
2011-05-27 21:51 ` Daniel Schoepe
2011-06-03 13:46 ` Daniel Schoepe
2011-06-10 5:42 ` Austin Clements
Code repositories for project(s) associated with this public inbox
https://yhetil.org/notmuch.git/
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).