;; notmuch-hello.el --- welcome to notmuch, a frontend ;; ;; Copyright © David Edmondson ;; ;; This file is part of Notmuch. ;; ;; Notmuch is free software: you can redistribute it and/or modify it ;; under the terms of the GNU General Public License as published by ;; the Free Software Foundation, either version 3 of the License, or ;; (at your option) any later version. ;; ;; Notmuch is distributed in the hope that it will be useful, but ;; WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU ;; General Public License for more details. ;; ;; You should have received a copy of the GNU General Public License ;; along with Notmuch. If not, see . ;; ;; Authors: David Edmondson (eval-when-compile (require 'cl)) (require 'widget) (require 'wid-edit) ; For `widget-forward'. (require 'notmuch-lib) (require 'notmuch-mua) (declare-function notmuch-search "notmuch" (query &optional oldest-first target-thread target-line continuation)) (declare-function notmuch-poll "notmuch" ()) (defvar notmuch-hello-search-bar-marker nil "The position of the search bar within the notmuch-hello buffer.") (defcustom notmuch-recent-searches-max 10 "The number of recent searches to store and display." :type 'integer :group 'notmuch) (defcustom notmuch-show-empty-saved-searches nil "Should saved searches with no messages be listed?" :type 'boolean :group 'notmuch) (defvar notmuch-hello-indent 4 "How much to indent non-headers.") (defcustom notmuch-show-logo t "Should the notmuch logo be shown?" :type 'boolean :group 'notmuch) (defcustom notmuch-show-all-tags-list nil "Should all tags be shown in the notmuch-hello view?" :type 'boolean :group 'notmuch) (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 '((((class color) (background dark)) (:background "#5f5f5f")) (((class color) (background light)) (:background "white"))) "Background colour for the notmuch logo." :group 'notmuch) (defcustom notmuch-column-control t "Controls the number of columns for saved searches/tags in notmuch view. This variable has three potential sets of values: - t: automatically calculate the number of columns possible based on the tags to be shown and the window width, - an integer: a lower bound on the number of characters that will be used to display each column, - a float: a fraction of the window width that is the lower bound on the number of characters that should be used for each column. So: - if you would like two columns of tags, set this to 0.5. - if you would like a single column of tags, set this to 1.0. - if you would like tags to be 30 characters wide, set this to 30. - if you don't want to worry about all of this nonsense, leave this set to `t'." :group 'notmuch :type '(choice (const :tag "Automatically calculated" t) (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.") (defvar notmuch-hello-recent-searches nil) (defun notmuch-hello-remember-search (search) (if (not (member search notmuch-hello-recent-searches)) (push search notmuch-hello-recent-searches)) (if (> (length notmuch-hello-recent-searches) 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) (match-string 1 search) search)) (defun notmuch-hello-search (search) (let ((search (notmuch-hello-trim search))) (notmuch-hello-remember-search search) (notmuch-search search notmuch-search-oldest-first nil nil #'notmuch-hello-search-continuation))) (defun notmuch-hello-add-saved-search (widget) (interactive) (let ((search (widget-value (symbol-value (widget-get widget :notmuch-saved-search-widget)))) (name (completing-read "Name for saved search: " notmuch-saved-searches))) ;; If an existing saved search with this name exists, remove it. (setq notmuch-saved-searches (loop for elem in notmuch-saved-searches if (not (equal name (car elem))) collect elem)) ;; Add the new one. (customize-save-variable 'notmuch-saved-searches (push (cons name search) notmuch-saved-searches)) (message "Saved '%s' as '%s'." search name) (notmuch-hello-update))) (defun notmuch-hello-longest-label (tag-alist) (or (loop for elem in tag-alist maximize (length (car elem))) 0)) (defun notmuch-hello-reflect-generate-row (ncols nrows row list) (let ((len (length list))) (loop for col from 0 to (- ncols 1) collect (let ((offset (+ (* nrows col) row))) (if (< offset len) (nth offset list) ;; Don't forget to insert an empty slot in the ;; output matrix if there is no corresponding ;; value in the input matrix. nil))))) (defun notmuch-hello-reflect (list ncols) "Reflect a `ncols' wide matrix represented by `list' along the diagonal." ;; Not very lispy... (let ((nrows (ceiling (length list) ncols))) (loop for row from 0 to (- nrows 1) append (notmuch-hello-reflect-generate-row ncols nrows row list)))) (defun notmuch-hello-widget-search (widget &rest ignore) (notmuch-search (widget-get widget :notmuch-search-terms) notmuch-search-oldest-first nil nil #'notmuch-hello-search-continuation)) (defun notmuch-saved-search-count (search) (car (process-lines notmuch-command "count" search))) (defun notmuch-hello-tags-per-line (widest) "Determine how many tags to show per line and how wide they should be. Returns a cons cell `(tags-per-line width)'." (let ((tags-per-line (cond ((integerp notmuch-column-control) (max 1 (/ (- (window-width) notmuch-hello-indent) ;; Count is 9 wide (8 digits plus space), 1 for the space ;; after the name. (+ 9 1 (max notmuch-column-control widest))))) ((floatp notmuch-column-control) (let* ((available-width (- (window-width) notmuch-hello-indent)) (proposed-width (max (* available-width notmuch-column-control) widest))) (floor available-width proposed-width))) (t (max 1 (/ (- (window-width) notmuch-hello-indent) ;; Count is 9 wide (8 digits plus space), 1 for the space ;; after the name. (+ 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-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-filtered tags-per-line)) ;; Hack the display of the buttons used. (widget-push-button-prefix "") (widget-push-button-suffix "") (found-target-pos nil)) ;; dme: It feels as though there should be a better way to ;; implement this loop than using an incrementing counter. (mapc (lambda (elem) ;; (not elem) indicates an empty slot in the matrix. (when elem (let* ((name (car 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 (cdr (assoc name count-alist))))) (if (string= formatted-name target) (setq found-target-pos (point-marker))) (widget-create 'push-button :notify #'notmuch-hello-widget-search :notmuch-search-terms query formatted-name) ;; Insert enough space to consume the rest of the ;; column. Because the button for the name is `(1+ ;; (length name))' long (due to the trailing space) we ;; can just insert `(- widest (length name))' spaces - ;; the column separator is included in the button if ;; `(equal 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"))) reordered-list) ;; If the last line was not full (and hence did not include a ;; carriage return), insert one now. (if (not (eq (% count tags-per-line) 0)) (widget-insert "\n")) found-target-pos)) (defun notmuch-hello-goto-search () "Put point inside the `search' widget." (interactive) (goto-char notmuch-hello-search-bar-marker)) (defimage notmuch-hello-logo ((:type png :file "notmuch-logo.png"))) (defun notmuch-hello-search-continuation() (notmuch-hello-update t)) (defun notmuch-hello-update (&optional no-display) "Update the current notmuch view." ;; Lazy - rebuild everything. (interactive) (notmuch-hello no-display)) (defun notmuch-hello-poll-and-update () "Invoke `notmuch-poll' to import mail, then refresh the current view." (interactive) (notmuch-poll) (notmuch-hello-update)) (defvar notmuch-hello-mode-map (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" '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-new-mail) (define-key map "s" 'notmuch-hello-goto-search) map) "Keymap for \"notmuch hello\" buffers.") (fset 'notmuch-hello-mode-map notmuch-hello-mode-map) (defun notmuch-hello-mode () "Major mode for convenient notmuch navigation. This is your entry portal into notmuch. Complete list of currently available key bindings: \\{notmuch-hello-mode-map}" (interactive) (kill-all-local-variables) (use-local-map notmuch-hello-mode-map) (setq major-mode 'notmuch-hello-mode mode-name "notmuch-hello") ;;(setq buffer-read-only t) ) (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) "Run notmuch and display saved searches, known tags, etc." (interactive) ; Jump through a hoop to get this value from the deprecated variable ; name (`notmuch-folders') or from the default value. (if (not notmuch-saved-searches) (setq notmuch-saved-searches (notmuch-saved-searches))) (if no-display (set-buffer "*notmuch-hello*") (switch-to-buffer "*notmuch-hello*")) (let ((target (if (widget-at) (widget-value (widget-at)) (condition-case nil (progn (widget-forward 1) (widget-value (widget-at))) (error nil))))) (kill-all-local-variables) (let ((inhibit-read-only t)) (erase-buffer)) (unless (eq major-mode 'notmuch-hello-mode) (notmuch-hello-mode)) (let ((all (overlay-lists))) ;; Delete all the overlays. (mapc 'delete-overlay (car all)) (mapc 'delete-overlay (cdr all))) (when notmuch-show-logo (let ((image notmuch-hello-logo)) ;; The notmuch logo uses transparency. That can display poorly ;; when inserting the image into an emacs buffer (black logo on ;; a black background), so force the background colour of the ;; image. We use a face to represent the colour so that ;; `defface' can be used to declare the different possible ;; colours, which depend on whether the frame has a light or ;; dark background. (setq image (cons 'image (append (cdr image) (list :background (face-background 'notmuch-hello-logo-background))))) (insert-image image)) (widget-insert " ")) (widget-insert "Welcome to ") ;; Hack the display of the links used. (let ((widget-link-prefix "") (widget-link-suffix "")) (widget-create 'link :notify (lambda (&rest ignore) (browse-url notmuch-hello-url)) :help-echo "Visit the notmuch website." "notmuch") (widget-insert ". ") (widget-insert "You have ") (widget-create 'link :notify (lambda (&rest ignore) (notmuch-hello-update)) :help-echo "Refresh" (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) (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 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)) (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: ") (widget-create 'push-button :notify (lambda (&rest ignore) (customize-variable 'notmuch-saved-searches)) "edit") (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)) (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 ;; Leave some space at the start and end of the ;; search boxes. :size (max 8 (- (window-width) notmuch-hello-indent (length "Search: "))) :action (lambda (widget &rest ignore) (notmuch-hello-search (widget-value widget)))) (widget-insert "\n") (when notmuch-hello-recent-searches (widget-insert "\nRecent searches: ") (widget-create 'push-button :notify (lambda (&rest ignore) (setq notmuch-hello-recent-searches nil) (notmuch-hello-update)) "clear") (widget-insert "\n\n") (let ((start (point)) (nth 0)) (mapc '(lambda (search) (let ((widget-symbol (intern (format "notmuch-hello-search-%d" nth)))) (set widget-symbol (widget-create 'editable-field ;; Don't let the search boxes be ;; less than 8 characters wide. :size (max 8 (- (window-width) ;; Leave some space ;; at the start and ;; end of the ;; boxes. (* 2 notmuch-hello-indent) ;; 1 for the space ;; before the ;; `[save]' button. 6 ;; for the `[save]' ;; button. 1 6)) :action (lambda (widget &rest ignore) (notmuch-hello-search (widget-value widget))) search)) (widget-insert " ") (widget-create 'push-button :notify (lambda (widget &rest ignore) (notmuch-hello-add-saved-search widget)) :notmuch-saved-search-widget widget-symbol "save")) (widget-insert "\n") (setq nth (1+ nth))) notmuch-hello-recent-searches) (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))) lower-sections)) (let ((start (point))) (widget-insert "\n\n") (widget-insert "Type a search query and hit RET to view matching threads.\n") (when notmuch-hello-recent-searches (widget-insert "Hit RET to re-submit a previous search. Edit it first if you like.\n") (widget-insert "Save recent searches with the `save' button.\n")) (when notmuch-saved-searches (widget-insert "Edit saved searches with the `edit' button.\n")) (widget-insert "Hit RET or click on a saved search or tag name to view matching threads.\n") (widget-insert "`=' refreshes this screen. `s' jumps to the search box. `q' to quit.\n") (let ((fill-column (- (window-width) notmuch-hello-indent))) (center-region start (point)))) (widget-setup) (when final-target-pos (goto-char final-target-pos) (unless (widget-at) (widget-forward 1))) (unless (widget-at) (notmuch-hello-goto-search))))) (defun notmuch-folder () "Deprecated function for invoking notmuch---calling `notmuch' is preferred now." (interactive) (notmuch-hello)) ;; (provide 'notmuch-hello)