(require 'message)
(require 'notmuch-lib)
+(require 'notmuch-tag)
(require 'notmuch-show)
(require 'notmuch-mua)
(require 'notmuch-hello)
(defvar notmuch-query-history nil
"Variable to store minibuffer history for notmuch queries")
-(defun notmuch-select-tag-with-completion (prompt &rest search-terms)
- (let ((tag-list
- (with-output-to-string
- (with-current-buffer standard-output
- (apply 'call-process notmuch-command nil t nil "search-tags" search-terms)))))
- (completing-read prompt (split-string tag-list "\n+" t) nil nil nil)))
-
(defun notmuch-foreach-mime-part (function mm-handle)
(cond ((stringp (car mm-handle))
(dolist (part (cdr mm-handle))
(set-buffer-modified-p nil)
(view-buffer (current-buffer) 'kill-buffer-if-not-modified))))
-(defcustom notmuch-search-hook '(hl-line-mode)
+(require 'hl-line)
+
+(defun notmuch-hl-line-mode ()
+ (prog1 (hl-line-mode)
+ (when hl-line-overlay
+ (overlay-put hl-line-overlay 'priority 1))))
+
+(defcustom notmuch-search-hook '(notmuch-hl-line-mode)
"List of functions to call when notmuch displays the search results."
:type 'hook
- :options '(hl-line-mode)
+ :options '(notmuch-hl-line-mode)
:group 'notmuch-search
:group 'notmuch-hooks)
(define-key map "t" 'notmuch-search-filter-by-tag)
(define-key map "f" 'notmuch-search-filter)
(define-key map [mouse-1] 'notmuch-search-show-thread)
- (define-key map "*" 'notmuch-search-operate-all)
+ (define-key map "*" 'notmuch-search-tag-all)
(define-key map "a" 'notmuch-search-archive-thread)
(define-key map "-" 'notmuch-search-remove-tag)
(define-key map "+" 'notmuch-search-add-tag)
Pressing \\[notmuch-search-show-thread] on any line displays that thread. The '\\[notmuch-search-add-tag]' and '\\[notmuch-search-remove-tag]'
keys can be used to add or remove tags from a thread. The '\\[notmuch-search-archive-thread]' key
is a convenience for archiving a thread (removing the \"inbox\"
-tag). The '\\[notmuch-search-operate-all]' key can be used to add or remove a tag from all
+tag). The '\\[notmuch-search-tag-all]' key can be used to add or remove a tag from all
threads in the current buffer.
Other useful commands are '\\[notmuch-search-filter]' for filtering the current search
"Return a list of threads for the current region"
(notmuch-search-properties-in-region 'notmuch-search-thread-id beg end))
+(defun notmuch-search-find-thread-id-region-search (beg end)
+ "Return a search string for threads for the current region"
+ (mapconcat 'identity (notmuch-search-find-thread-id-region beg end) " or "))
+
(defun notmuch-search-find-authors ()
"Return the authors for the current thread"
(get-text-property (point) 'notmuch-search-authors))
"Return a list of authors for the current region"
(notmuch-search-properties-in-region 'notmuch-search-subject beg end))
-(defun notmuch-search-show-thread (&optional crypto-switch)
+(defun notmuch-search-show-thread ()
"Display the currently selected thread."
- (interactive "P")
+ (interactive)
(let ((thread-id (notmuch-search-find-thread-id))
(subject (notmuch-search-find-subject)))
(if (> (length thread-id) 0)
(notmuch-show thread-id
(current-buffer)
notmuch-search-query-string
- ;; name the buffer based on notmuch-search-find-subject
- (if (string-match "^[ \t]*$" subject)
- "[No Subject]"
- (truncate-string-to-width
- (concat "*"
- (truncate-string-to-width subject 32 nil nil t)
- "*")
- 32 nil nil t))
- crypto-switch)
+ ;; Name the buffer based on the subject.
+ (concat "*" (truncate-string-to-width subject 30 nil nil t) "*"))
(message "End of search results."))))
(defun notmuch-search-reply-to-thread (&optional prompt-for-sender)
(error (buffer-substring beg end))
))))))
-(defun notmuch-tag (query &rest tags)
- "Add/remove tags in TAGS to messages matching QUERY.
-
-TAGS should be a list of strings of the form \"+TAG\" or \"-TAG\" and
-QUERY should be a string containing the search-query.
-
-Note: Other code should always use this function alter tags of
-messages instead of running (notmuch-call-notmuch-process \"tag\" ..)
-directly, so that hooks specified in notmuch-before-tag-hook and
-notmuch-after-tag-hook will be run."
- (run-hooks 'notmuch-before-tag-hook)
- (apply 'notmuch-call-notmuch-process
- (append (list "tag") tags (list "--" query)))
- (run-hooks 'notmuch-after-tag-hook))
-
-(defcustom notmuch-before-tag-hook nil
- "Hooks that are run before tags of a message are modified.
-
-'tags' will contain the tags that are about to be added or removed as
-a list of strings of the form \"+TAG\" or \"-TAG\".
-'query' will be a string containing the search query that determines
-the messages that are about to be tagged"
-
- :type 'hook
- :options '(hl-line-mode)
- :group 'notmuch-hooks)
-
-(defcustom notmuch-after-tag-hook nil
- "Hooks that are run after tags of a message are modified.
-
-'tags' will contain the tags that were added or removed as
-a list of strings of the form \"+TAG\" or \"-TAG\".
-'query' will be a string containing the search query that determines
-the messages that were tagged"
- :type 'hook
- :options '(hl-line-mode)
- :group 'notmuch-hooks)
-
(defun notmuch-search-set-tags (tags)
(save-excursion
(end-of-line)
(let ((beg (+ (point) 1)))
(re-search-forward ")")
(let ((end (- (point) 1)))
- (split-string (buffer-substring beg end))))))
+ (split-string (buffer-substring-no-properties beg end))))))
(defun notmuch-search-get-tags-region (beg end)
(save-excursion
(forward-line 1))
output)))
-(defun notmuch-search-add-tag-thread (tag)
- (notmuch-search-add-tag-region tag (point) (point)))
-
-(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-tag search-id-string (concat "+" tag))
- (save-excursion
- (let ((last-line (line-number-at-pos end))
- (max-line (- (line-number-at-pos (point-max)) 2)))
- (goto-char beg)
- (while (<= (line-number-at-pos) (min last-line max-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-search-remove-tag-region tag (point) (point)))
-
-(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-tag search-id-string (concat "-" tag))
+(defun notmuch-search-tag-region (beg end &optional tag-changes)
+ "Change tags for threads in the given region."
+ (let ((search-string (notmuch-search-find-thread-id-region-search beg end)))
+ (setq tag-changes (funcall 'notmuch-tag search-string tag-changes))
(save-excursion
(let ((last-line (line-number-at-pos end))
(max-line (- (line-number-at-pos (point-max)) 2)))
(goto-char beg)
(while (<= (line-number-at-pos) (min last-line max-line))
- (notmuch-search-set-tags (delete tag (notmuch-search-get-tags)))
+ (notmuch-search-set-tags
+ (notmuch-update-tags (notmuch-search-get-tags) tag-changes))
(forward-line))))))
-(defun notmuch-search-add-tag (tag)
- "Add a tag to the currently selected thread or region.
+(defun notmuch-search-tag (&optional tag-changes)
+ "Change tags for the currently selected thread or region.
-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: ")))
- (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))))
+See `notmuch-tag' for information on the format of TAG-CHANGES."
+ (interactive)
+ (let* ((beg (if (region-active-p) (region-beginning) (point)))
+ (end (if (region-active-p) (region-end) (point))))
+ (funcall 'notmuch-search-tag-region beg end tag-changes)))
-(defun notmuch-search-remove-tag (tag)
- "Remove a tag from the currently selected thread or region.
+(defun notmuch-search-add-tag ()
+ "Same as `notmuch-search-tag' but sets initial input to '+'."
+ (interactive)
+ (notmuch-search-tag "+"))
-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: "
- (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-remove-tag ()
+ "Same as `notmuch-search-tag' but sets initial input to '-'."
+ (interactive)
+ (notmuch-search-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-thread "inbox")
+ (notmuch-search-tag '("-inbox"))
(notmuch-search-next-thread))
(defvar notmuch-search-process-filter-data nil
(goto-char (point-max))
(if (eq status 'signal)
(insert "Incomplete search results (search process was killed).\n"))
- (if (eq status 'exit)
- (progn
- (if notmuch-search-process-filter-data
- (insert (concat "Error: Unexpected output from notmuch search:\n" notmuch-search-process-filter-data)))
- (insert "End of search results.")
- (unless (= exit-status 0)
- (insert (format " (process returned %d)" exit-status)))
- (insert "\n")
- (if (and atbob
- (not (string= notmuch-search-target-thread "found")))
- (set 'never-found-target-thread t))))))
+ (when (eq status 'exit)
+ (if notmuch-search-process-filter-data
+ (insert (concat "Error: Unexpected output from notmuch search:\n" notmuch-search-process-filter-data)))
+ (insert "End of search results.")
+ (unless (= exit-status 0)
+ (insert (format " (process returned %d)" exit-status)))
+ (insert "\n")
+ (if (and atbob
+ (not (string= notmuch-search-target-thread "found")))
+ (set 'never-found-target-thread t)))))
(when (and never-found-target-thread
notmuch-search-target-line)
(goto-char (point-min))
(forward-line (1- notmuch-search-target-line))))))))
-(defcustom notmuch-search-line-faces nil
+(defcustom notmuch-search-line-faces '(("unread" :weight bold)
+ ("flagged" :foreground "blue"))
"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\"
+ (setq notmuch-search-line-faces '((\"deleted\" . (:foreground \"red\"
:background \"blue\"))
(\"unread\" . (:foreground \"green\"))))
The attributes defined for matching tags are merged, with later
-attributes overriding earlier. A message having both \"delete\"
+attributes overriding earlier. A message having both \"deleted\"
and \"unread\" tags with the above settings would have a green
foreground and blue background."
:type '(alist :key-type (string) :value-type (custom-face-edit))
(goto-char (point-max))
(if (/= (match-beginning 1) line)
(insert (concat "Error: Unexpected output from notmuch search:\n" (substring string line (match-beginning 1)) "\n")))
- (let ((beg (point)))
- (notmuch-search-show-result date count authors subject tags)
- (notmuch-search-color-line beg (point) tag-list)
- (put-text-property beg (point) 'notmuch-search-thread-id thread-id)
- (put-text-property beg (point) 'notmuch-search-authors authors)
- (put-text-property beg (point) 'notmuch-search-subject subject)
- (if (string= thread-id notmuch-search-target-thread)
- (progn
- (set 'found-target beg)
- (set 'notmuch-search-target-thread "found"))))
+ ;; We currently just throw away excluded matches.
+ (unless (eq (aref count 1) ?0)
+ (let ((beg (point)))
+ (notmuch-search-show-result date count authors subject tags)
+ (notmuch-search-color-line beg (point) tag-list)
+ (put-text-property beg (point) 'notmuch-search-thread-id thread-id)
+ (put-text-property beg (point) 'notmuch-search-authors authors)
+ (put-text-property beg (point) 'notmuch-search-subject subject)
+ (when (string= thread-id notmuch-search-target-thread)
+ (set 'found-target beg)
+ (set 'notmuch-search-target-thread "found"))))
(set 'line (match-end 0)))
(set 'more nil)
(while (and (< line (length string)) (= (elt string line) ?\n))
(goto-char found-target)))
(delete-process proc))))
-(defun notmuch-search-operate-all (action)
- "Add/remove tags from all matching messages.
-
-This command adds or removes tags from all messages matching the
-current search terms. When called interactively, this command
-will prompt for tags to be added or removed. Tags prefixed with
-'+' will be added and tags prefixed with '-' will be removed.
-
-Each character of the tag name may consist of alphanumeric
-characters as well as `_.+-'.
-"
- (interactive "sOperation (+add -drop): notmuch tag ")
- (let ((action-split (split-string action " +")))
- ;; Perform some validation
- (let ((words action-split))
- (when (null words) (error "No operation given"))
- (while words
- (unless (string-match-p "^[-+][-+_.[:word:]]+$" (car words))
- (error "Action must be of the form `+thistag -that_tag'"))
- (setq words (cdr words))))
- (apply 'notmuch-tag notmuch-search-query-string action-split)))
+(defun notmuch-search-tag-all (&optional tag-changes)
+ "Add/remove tags from all messages in current search buffer.
+
+See `notmuch-tag' for information on the format of TAG-CHANGES."
+ (interactive)
+ (apply 'notmuch-tag notmuch-search-query-string tag-changes))
(defun notmuch-search-buffer-title (query)
"Returns the title for a buffer with notmuch search results."
completions)))
(t (list string)))))))
;; this was simpler than convincing completing-read to accept spaces:
- (define-key keymap (kbd "<tab>") 'minibuffer-complete)
+ (define-key keymap (kbd "TAB") 'minibuffer-complete)
(let ((history-delete-duplicates t))
(read-from-minibuffer prompt nil keymap nil
'notmuch-search-history nil nil)))))