X-Git-Url: https://git.notmuchmail.org/git?p=notmuch;a=blobdiff_plain;f=emacs%2Fnotmuch.el;h=517c53a5d3784a5c2d8362f319b2e436ac640d19;hp=9ff376786c476cd17ea8783fbe8a4e1f58baf3cc;hb=fec5622add1a4e9f305c16e96143439ee22a5c58;hpb=fbec989fe3272d6eff038369587be076347b96f0 diff --git a/emacs/notmuch.el b/emacs/notmuch.el index 9ff37678..517c53a5 100644 --- a/emacs/notmuch.el +++ b/emacs/notmuch.el @@ -396,24 +396,57 @@ Complete list of currently available key bindings: (set (make-local-variable 'font-lock-defaults) '(notmuch-search-font-lock-keywords t))) +(defun notmuch-search-properties-in-region (property beg end) + (save-excursion + (let ((output nil) + (last-line (line-number-at-pos end))) + (goto-char beg) + (beginning-of-line) + (while (<= (line-number-at-pos) last-line) + (setq output (cons (get-text-property (point) property) output)) + (forward-line 1)) + output))) + (defun notmuch-search-find-thread-id () "Return the thread for the current thread" (get-text-property (point) 'notmuch-search-thread-id)) +(defun notmuch-search-find-thread-id-region (beg end) + "Return a list of threads for the current region" + (notmuch-search-properties-in-region 'notmuch-search-thread-id beg end)) + (defun notmuch-search-find-authors () "Return the authors for the current thread" (get-text-property (point) 'notmuch-search-authors)) +(defun notmuch-search-find-authors-region (beg end) + "Return a list of authors for the current region" + (notmuch-search-properties-in-region 'notmuch-search-authors beg end)) + (defun notmuch-search-find-subject () "Return the subject for the current thread" (get-text-property (point) 'notmuch-search-subject)) +(defun notmuch-search-find-subject-region (beg end) + "Return a list of authors for the current region" + (notmuch-search-properties-in-region 'notmuch-search-subject beg end)) + (defun notmuch-search-show-thread () "Display the currently selected thread." (interactive) - (let ((thread-id (notmuch-search-find-thread-id))) + (let ((thread-id (notmuch-search-find-thread-id)) + (subject (notmuch-search-find-subject)) + buffer-name) + (when (string-match "^[ \t]*$" subject) + (setq subject "[No Subject]")) + (setq buffer-name (concat "*" + (truncate-string-to-width subject 32 nil nil t) + "*")) (if (> (length thread-id) 0) - (notmuch-show thread-id (current-buffer) notmuch-search-query-string) + (notmuch-show thread-id + (current-buffer) + notmuch-search-query-string + buffer-name) (error "End of search results")))) (defun notmuch-search-reply-to-thread () @@ -461,31 +494,84 @@ and will also appear in a buffer named \"*Notmuch errors*\"." (let ((end (- (point) 1))) (split-string (buffer-substring beg end)))))) +(defun notmuch-search-get-tags-region (beg end) + (save-excursion + (let ((output nil) + (last-line (line-number-at-pos end))) + (goto-char beg) + (while (<= (line-number-at-pos) last-line) + (setq output (append output (notmuch-search-get-tags))) + (forward-line 1)) + output))) + +(defun notmuch-search-add-tag-thread (tag) + (notmuch-call-notmuch-process "tag" (concat "+" tag) (notmuch-search-find-thread-id)) + (notmuch-search-set-tags (delete-dups (sort (cons tag (notmuch-search-get-tags)) 'string<)))) + +(defun notmuch-search-add-tag-region (tag beg end) + (let ((search-id-string (mapconcat 'identity (notmuch-search-find-thread-id-region beg end) " or "))) + (notmuch-call-notmuch-process "tag" (concat "+" tag) search-id-string) + (save-excursion + (let ((last-line (line-number-at-pos end))) + (goto-char beg) + (while (<= (line-number-at-pos) last-line) + (notmuch-search-set-tags (delete-dups (sort (cons tag (notmuch-search-get-tags)) 'string<))) + (forward-line)))))) + +(defun notmuch-search-remove-tag-thread (tag) + (notmuch-call-notmuch-process "tag" (concat "-" tag) (notmuch-search-find-thread-id)) + (notmuch-search-set-tags (delete tag (notmuch-search-get-tags)))) + +(defun notmuch-search-remove-tag-region (tag beg end) + (let ((search-id-string (mapconcat 'identity (notmuch-search-find-thread-id-region beg end) " or "))) + (notmuch-call-notmuch-process "tag" (concat "-" tag) search-id-string) + (save-excursion + (let ((last-line (line-number-at-pos end))) + (goto-char beg) + (while (<= (line-number-at-pos) last-line) + (notmuch-search-set-tags (delete tag (notmuch-search-get-tags))) + (forward-line)))))) + (defun notmuch-search-add-tag (tag) - "Add a tag to the currently selected thread. + "Add a tag to the currently selected thread or region. -The tag is added to messages in the currently selected thread -which match the current search terms." +The tag is added to all messages in the currently selected thread +or threads in the current region." (interactive (list (notmuch-select-tag-with-completion "Tag to add: "))) - (notmuch-call-notmuch-process "tag" (concat "+" tag) (notmuch-search-find-thread-id)) - (notmuch-search-set-tags (delete-dups (sort (cons tag (notmuch-search-get-tags)) 'string<)))) + (save-excursion + (if (region-active-p) + (let* ((beg (region-beginning)) + (end (region-end))) + (notmuch-search-add-tag-region tag beg end)) + (notmuch-search-add-tag-thread tag)))) (defun notmuch-search-remove-tag (tag) - "Remove a tag from the currently selected thread. + "Remove a tag from the currently selected thread or region. -The tag is removed from all messages in the currently selected thread." +The tag is removed from all messages in the currently selected +thread or threads in the current region." (interactive - (list (notmuch-select-tag-with-completion "Tag to remove: " (notmuch-search-find-thread-id)))) - (notmuch-call-notmuch-process "tag" (concat "-" tag) (notmuch-search-find-thread-id)) - (notmuch-search-set-tags (delete tag (notmuch-search-get-tags)))) + (list (notmuch-select-tag-with-completion + "Tag to remove: " + (if (region-active-p) + (mapconcat 'identity + (notmuch-search-find-thread-id-region (region-beginning) (region-end)) + " ") + (notmuch-search-find-thread-id))))) + (save-excursion + (if (region-active-p) + (let* ((beg (region-beginning)) + (end (region-end))) + (notmuch-search-remove-tag-region tag beg end)) + (notmuch-search-remove-tag-thread tag)))) (defun notmuch-search-archive-thread () "Archive the currently selected thread (remove its \"inbox\" tag). This function advances the next thread when finished." (interactive) - (notmuch-search-remove-tag "inbox") + (notmuch-search-remove-tag-thread "inbox") (forward-line)) (defun notmuch-search-process-sentinel (proc msg) @@ -516,6 +602,35 @@ This function advances the next thread when finished." notmuch-search-target-line) (goto-line notmuch-search-target-line))))))) +(defcustom notmuch-search-line-faces nil + "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): + +(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." + :type '(alist :key-type (string) :value-type (list)) + :group 'notmuch) + +(defun notmuch-search-color-line (start end line-tag-list) + "Colorize lines in notmuch-show based on tags" + (if notmuch-search-line-faces + (let ((overlay (make-overlay start end)) + (tags-faces (copy-alist notmuch-search-line-faces))) + (while tags-faces + (let* ((tag-face (car tags-faces)) + (tag (car tag-face)) + (face (cdr tag-face))) + (cond ((member tag line-tag-list) + (overlay-put overlay 'face face) + (setq tags-faces nil)) + (t + (setq tags-faces (cdr tags-faces))))))))) + (defun notmuch-search-process-filter (proc string) "Process and filter the output of \"notmuch search\"" (let ((buffer (process-buffer proc)) @@ -534,13 +649,15 @@ This function advances the next thread when finished." (authors (match-string 4 string)) (authors-length (length authors)) (subject (match-string 5 string)) - (tags (match-string 6 string))) + (tags (match-string 6 string)) + (tag-list (if tags (save-match-data (split-string tags))))) (if (> authors-length notmuch-search-authors-width) (set 'authors (concat (substring authors 0 (- notmuch-search-authors-width 3)) "..."))) (goto-char (point-max)) (let ((beg (point-marker)) (format-string (format "%%s %%-7s %%-%ds %%s (%%s)\n" notmuch-search-authors-width))) (insert (format format-string date count authors subject tags)) + (notmuch-search-color-line beg (point-marker) tag-list) (put-text-property beg (point-marker) 'notmuch-search-thread-id thread-id) (put-text-property beg (point-marker) 'notmuch-search-authors authors) (put-text-property beg (point-marker) 'notmuch-search-subject subject)