X-Git-Url: https://git.notmuchmail.org/git?p=notmuch;a=blobdiff_plain;f=emacs%2Fnotmuch-hello.el;h=1a76c30abed9d79eafe1da8c30acc9ad5bf93561;hp=02d8f0c4e1ddddeb958a19fb8ba6579ed8f02493;hb=e972d752c038b015b0af92de4ce1e00aa2557b71;hpb=e229bfa5aa68ce0e9076b04cac7774a754b47ab2 diff --git a/emacs/notmuch-hello.el b/emacs/notmuch-hello.el index 02d8f0c4..1a76c30a 100644 --- a/emacs/notmuch-hello.el +++ b/emacs/notmuch-hello.el @@ -19,9 +19,9 @@ ;; ;; Authors: David Edmondson +(eval-when-compile (require 'cl)) (require 'widget) (require 'wid-edit) ; For `widget-forward'. -(require 'cl) (require 'notmuch-lib) (require 'notmuch-mua) @@ -55,6 +55,26 @@ :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)) @@ -91,6 +111,13 @@ So: (integer :tag "Number of characters") (float :tag "Fraction of window"))) +(defcustom notmuch-decimal-separator "," + "The string used as a decimal separator. + +Typically \",\" in the US and UK and \".\" in Europe." + :group 'notmuch + :type 'string) + (defvar notmuch-hello-url "http://notmuchmail.org" "The `notmuch' web site.") @@ -103,6 +130,18 @@ So: notmuch-recent-searches-max) (setq notmuch-hello-recent-searches (butlast notmuch-hello-recent-searches)))) +(defun notmuch-hello-nice-number (n) + (let (result) + (while (> n 0) + (push (% n 1000) result) + (setq n (/ n 1000))) + (setq result (or result '(0))) + (apply #'concat + (number-to-string (car result)) + (mapcar (lambda (elem) + (format "%s%03d" notmuch-decimal-separator elem)) + (cdr result))))) + (defun notmuch-hello-trim (search) "Trim whitespace." (if (string-match "^[[:space:]]*\\(.*[^[:space:]]\\)[[:space:]]*$" search) @@ -175,9 +214,9 @@ should be. Returns a cons cell `(tags-per-line width)'." ((integerp notmuch-column-control) (max 1 (/ (- (window-width) notmuch-hello-indent) - ;; Count is 7 wide (6 digits plus space), 1 for the space + ;; Count is 9 wide (8 digits plus space), 1 for the space ;; after the name. - (+ 7 1 (max notmuch-column-control widest))))) + (+ 9 1 (max notmuch-column-control widest))))) ((floatp notmuch-column-control) (let* ((available-width (- (window-width) notmuch-hello-indent)) @@ -187,12 +226,16 @@ should be. Returns a cons cell `(tags-per-line width)'." (t (max 1 (/ (- (window-width) notmuch-hello-indent) - ;; Count is 7 wide (6 digits plus space), 1 for the space + ;; Count is 9 wide (8 digits plus space), 1 for the space ;; after the name. - (+ 7 1 widest))))))) - - (cons tags-per-line (/ (- (window-width) notmuch-hello-indent - (* tags-per-line (+ 7 1))) + (+ 9 1 widest))))))) + + (cons tags-per-line (/ (max 1 + (- (window-width) notmuch-hello-indent + ;; Count is 9 wide (8 digits plus + ;; space), 1 for the space after the + ;; name. + (* tags-per-line (+ 9 1)))) tags-per-line)))) (defun notmuch-hello-insert-tags (tag-alist widest target) @@ -213,7 +256,9 @@ should be. Returns a cons cell `(tags-per-line width)'." (let* ((name (car elem)) (query (cdr elem)) (formatted-name (format "%s " name))) - (widget-insert (format "%6s " (notmuch-saved-search-count query))) + (widget-insert (format "%8s " + (notmuch-hello-nice-number + (string-to-number (notmuch-saved-search-count query))))) (if (string= formatted-name target) (setq found-target-pos (point-marker))) (widget-create 'push-button @@ -226,7 +271,9 @@ should be. Returns a cons cell `(tags-per-line width)'." ;; can just insert `(- widest (length name))' spaces - ;; the column separator is included in the button if ;; `(equal widest (length name)'. - (widget-insert (make-string (- widest (length name)) ? )))) + (widget-insert (make-string (max 1 + (- widest (length name))) + ? )))) (setq count (1+ count)) (if (eq (% count tags-per-line) 0) (widget-insert "\n"))) @@ -262,15 +309,16 @@ should be. Returns a cons cell `(tags-per-line width)'." (defvar notmuch-hello-mode-map - (let ((map (copy-keymap widget-keymap))) + (let ((map (make-sparse-keymap))) + (set-keymap-parent map widget-keymap) (define-key map "v" '(lambda () "Display the notmuch version" (interactive) (message "notmuch version %s" (notmuch-version)))) (define-key map "?" 'notmuch-help) - (define-key map "q" 'kill-this-buffer) + (define-key map "q" 'notmuch-kill-this-buffer) (define-key map "=" 'notmuch-hello-update) (define-key map "G" 'notmuch-hello-poll-and-update) (define-key map (kbd "") 'widget-backward) - (define-key map "m" 'notmuch-mua-mail) + (define-key map "m" 'notmuch-mua-new-mail) (define-key map "s" 'notmuch-hello-goto-search) map) "Keymap for \"notmuch hello\" buffers.") @@ -290,7 +338,28 @@ 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." (interactive) ; Jump through a hoop to get this value from the deprecated variable @@ -352,22 +421,21 @@ Complete list of currently available key bindings: :notify (lambda (&rest ignore) (notmuch-hello-update)) :help-echo "Refresh" - (car (process-lines notmuch-command "count"))) - (widget-insert " messages (that's not much mail).\n")) + (notmuch-hello-nice-number + (string-to-number (car (process-lines notmuch-command "count"))))) + (widget-insert " messages.\n")) (let ((found-target-pos nil) (final-target-pos nil)) (let* ((saved-alist - ;; Filter out empty saved seaches if required. + ;; Filter out empty saved searches if required. (if notmuch-show-empty-saved-searches notmuch-saved-searches (loop for elem in notmuch-saved-searches 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))) @@ -394,6 +462,10 @@ Complete list of currently available key bindings: (length "Search: "))) :action (lambda (widget &rest ignore) (notmuch-hello-search (widget-value widget)))) + ;; add an invisible space to make `widget-end-of-line' ignore + ;; trailine spaces in the search widget field + (widget-insert " ") + (put-text-property (1- (point)) (point) 'invisible t) (widget-insert "\n") (when notmuch-hello-recent-searches @@ -485,7 +557,6 @@ Complete list of currently available key bindings: (unless (widget-at) (notmuch-hello-goto-search))))) -;;;###autoload (defun notmuch-folder () "Deprecated function for invoking notmuch---calling `notmuch' is preferred now." (interactive)