X-Git-Url: https://git.notmuchmail.org/git?a=blobdiff_plain;f=emacs%2Fnotmuch.el;h=fe1041f013f864f56d0b49276e5b64eb079dddd6;hb=17b09af22809d32cd6bf8050bb30f80d9810944f;hp=27e3a4094c398f9b7393ae19565ba611a1bab21b;hpb=f2ebe3ac446afda9ced6507dc391865464ccdcaa;p=notmuch diff --git a/emacs/notmuch.el b/emacs/notmuch.el index 27e3a409..fe1041f0 100644 --- a/emacs/notmuch.el +++ b/emacs/notmuch.el @@ -56,6 +56,7 @@ (require 'notmuch-mua) (require 'notmuch-hello) (require 'notmuch-maildir-fcc) +(require 'notmuch-message) (defcustom notmuch-search-result-format `(("date" . "%s ") @@ -284,6 +285,38 @@ For a mouse binding, return nil." "Face for the single-line message summary in notmuch-show-mode." :group 'notmuch) +(defface notmuch-search-date + '((t :inherit default)) + "Face used in search mode for dates." + :group 'notmuch) + +(defface notmuch-search-count + '((t :inherit default)) + "Face used in search mode for the count matching the query." + :group 'notmuch) + +(defface notmuch-search-subject + '((t :inherit default)) + "Face used in search mode for subjects." + :group 'notmuch) + +(defface notmuch-search-matching-authors + '((t :inherit default)) + "Face used in search mode for authors matching the query." + :group 'notmuch) + +(defface notmuch-search-non-matching-authors + '((((class color) + (background dark)) + (:foreground "grey30")) + (((class color) + (background light)) + (:foreground "grey60")) + (t + (:italic t))) + "Face used in search mode for authors not matching the query." + :group 'notmuch) + (defface notmuch-tag-face '((((class color) (background dark)) @@ -293,7 +326,7 @@ For a mouse binding, return nil." (:foreground "navy blue" :bold t)) (t (:bold t))) - "Notmuch search mode face used to highligh tags." + "Face used in search mode face for tags." :group 'notmuch) ;;;###autoload @@ -426,7 +459,7 @@ and will also appear in a buffer named \"*Notmuch errors*\"." (let ((end (point))) (delete-region beg end) (insert (propertize (mapconcat 'identity tags " ") - 'font-lock-face 'notmuch-tag-face)))))) + 'face 'notmuch-tag-face)))))) (defun notmuch-search-get-tags () (save-excursion @@ -550,10 +583,10 @@ This function advances the next thread when finished." "Tag/face mapping for line highlighting in notmuch-search. Here is an example of how to color search results based on tags. -(the following text would be placed in your ~/.emacs file): + (the following text would be placed in your ~/.emacs file): -(setq notmuch-search-line-faces '((\"delete\" . '(:foreground \"red\")) - (\"unread\" . '(:foreground \"green\")))) + (setq notmuch-search-line-faces '((\"delete\" . '(:foreground \"red\")) + (\"unread\" . '(:foreground \"green\")))) Order matters: for lines with multiple tags, the the first matching will be applied." @@ -575,22 +608,68 @@ matching will be applied." (t (setq tags-faces (cdr tags-faces))))))))) +(defun notmuch-search-isearch-authors-show (overlay) + (remove-from-invisibility-spec (cons (overlay-get overlay 'invisible) t))) + +(defun notmuch-search-insert-authors (format-string authors) + (let* ((propertized-authors + ;; Need to save the match data to avoid interfering with + ;; `notmuch-search-process-filter'. + (save-match-data + ;; Authors that don't match the search query are shown in a + ;; different font. + (if (string-match "\\(.*\\)|\\(..*\\)" authors) + (concat (propertize (concat (match-string 1 authors) ",") + 'face 'notmuch-search-matching-authors) + (propertize (match-string 2 authors) + 'face 'notmuch-search-non-matching-authors)) + (propertize authors 'face 'notmuch-search-matching-authors)))) + + (formatted-sample (format format-string "")) + (formatted-authors (format format-string propertized-authors)) + visible-string invisible-string) + + ;; Determine the part of the authors that will be visible by + ;; default. + (if (> (length formatted-authors) + (length formatted-sample)) + ;; 4 is `(length "... ")'. + (let ((visible-length (- (length formatted-sample) 4))) + (setq visible-string (substring propertized-authors 0 visible-length) + invisible-string (substring propertized-authors visible-length))) + (setq visible-string formatted-authors + invisible-string nil)) + + ;; Insert both the visible and invisible author strings. + (insert visible-string) + (when invisible-string + (let ((start (point)) + (invis-spec (make-symbol "notmuch-search-authors")) + overlay) + (insert invisible-string) + ;; Using a cons-cell here causes an ellipsis to be inserted + ;; instead of the invisible text. + (add-to-invisibility-spec (cons invis-spec t)) + (setq overlay (make-overlay start (point))) + (overlay-put overlay 'invisible invis-spec) + (overlay-put overlay 'isearch-open-invisible #'notmuch-search-isearch-authors-show) + (insert " "))))) + (defun notmuch-search-insert-field (field date count authors subject tags) (cond ((string-equal field "date") - (insert (format (cdr (assoc field notmuch-search-result-format)) date))) + (insert (propertize (format (cdr (assoc field notmuch-search-result-format)) date) + 'face 'notmuch-search-date))) ((string-equal field "count") - (insert (format (cdr (assoc field notmuch-search-result-format)) count))) - ((string-equal field "authors") - (insert (let* ((format-string (cdr (assoc field notmuch-search-result-format))) - (formatted-sample (format format-string "")) - (formatted-authors (format format-string authors))) - (if (> (length formatted-authors) - (length formatted-sample)) - (concat (substring authors 0 (- (length formatted-sample) 4)) "... ") - formatted-authors)))) + (insert (propertize (format (cdr (assoc field notmuch-search-result-format)) count) + 'face 'notmuch-search-count))) ((string-equal field "subject") - (insert (format (cdr (assoc field notmuch-search-result-format)) subject))) + (insert (propertize (format (cdr (assoc field notmuch-search-result-format)) subject) + 'face 'notmuch-search-subject))) + + ((string-equal field "authors") + (notmuch-search-insert-authors (cdr (assoc field notmuch-search-result-format)) authors)) + ((string-equal field "tags") (insert (concat "(" (propertize tags 'font-lock-face 'notmuch-tag-face) ")"))))) @@ -662,19 +741,19 @@ characters as well as `_.+-'. (defun notmuch-search-buffer-title (query) "Returns the title for a buffer with notmuch search results." - (let* ((folder (rassoc-if (lambda (key) - (string-match (concat "^" (regexp-quote key) "$") - query)) - (notmuch-saved-searches))) - (folder-name (car folder)) - (folder-query (cdr folder))) - (cond ((and folder (equal folder-query query)) - ;; Query is the same as folder search (ignoring case) - (concat "*notmuch-folder-" folder-name "*")) - (folder + (let* ((saved-search (rassoc-if (lambda (key) + (string-match (concat "^" (regexp-quote key)) + query)) + (reverse (notmuch-saved-searches)))) + (saved-search-name (car saved-search)) + (saved-search-query (cdr saved-search))) + (cond ((and saved-search (equal saved-search-query query)) + ;; Query is the same as saved search (ignoring case) + (concat "*notmuch-saved-search-" saved-search-name "*")) + (saved-search (concat "*notmuch-search-" - (replace-regexp-in-string (concat "^" (regexp-quote folder-query)) - (concat "[ " folder-name " ]") + (replace-regexp-in-string (concat "^" (regexp-quote saved-search-query)) + (concat "[ " saved-search-name " ]") query) "*")) (t