X-Git-Url: https://git.notmuchmail.org/git?p=notmuch;a=blobdiff_plain;f=emacs%2Fnotmuch.el;h=11113fe8ca9d1a2edce1545de0f2ace3352b61f2;hp=05c2ff7a77ecee826bb9dc6aea7c192272e9be58;hb=e06943f85ea31721d375731b93e5468570d1c375;hpb=e516a712bb79e523629012ee6a8325f5166b4ee5 diff --git a/emacs/notmuch.el b/emacs/notmuch.el index 05c2ff7a..11113fe8 100644 --- a/emacs/notmuch.el +++ b/emacs/notmuch.el @@ -76,38 +76,65 @@ For example: (defvar notmuch-query-history nil "Variable to store minibuffer history for notmuch queries") -(defun notmuch-tag-completions (&optional prefixes search-terms) - (let ((tag-list - (split-string - (with-output-to-string - (with-current-buffer standard-output - (apply 'call-process notmuch-command nil t - nil "search-tags" search-terms))) - "\n+" t))) - (if (null prefixes) - tag-list - (apply #'append - (mapcar (lambda (tag) - (mapcar (lambda (prefix) - (concat prefix tag)) prefixes)) - tag-list))))) +(defvar notmuch-select-tag-history nil + "Variable to store minibuffer history for +`notmuch-select-tag-with-completion' function.") + +(defvar notmuch-read-tag-changes-history nil + "Variable to store minibuffer history for +`notmuch-read-tag-changes' function.") + +(defun notmuch-tag-completions (&optional search-terms) + (split-string + (with-output-to-string + (with-current-buffer standard-output + (apply 'call-process notmuch-command nil t + nil "search-tags" search-terms))) + "\n+" t)) (defun notmuch-select-tag-with-completion (prompt &rest search-terms) - (let ((tag-list (notmuch-tag-completions nil search-terms))) - (completing-read prompt tag-list))) - -(defun notmuch-select-tags-with-completion (prompt &optional prefixes &rest search-terms) - (let ((tag-list (notmuch-tag-completions prefixes search-terms)) - (crm-separator " ") - ;; By default, space is bound to "complete word" function. - ;; Re-bind it to insert a space instead. Note that - ;; still does the completion. - (crm-local-completion-map - (let ((map (make-sparse-keymap))) - (set-keymap-parent map crm-local-completion-map) - (define-key map " " 'self-insert-command) - map))) - (delete "" (completing-read-multiple prompt tag-list)))) + (let ((tag-list (notmuch-tag-completions search-terms))) + (completing-read prompt tag-list nil nil nil 'notmuch-select-tag-history))) + +(defun notmuch-read-tag-changes (&optional initial-input &rest search-terms) + (let* ((all-tag-list (notmuch-tag-completions)) + (add-tag-list (mapcar (apply-partially 'concat "+") all-tag-list)) + (remove-tag-list (mapcar (apply-partially 'concat "-") + (if (null search-terms) + all-tag-list + (notmuch-tag-completions search-terms)))) + (tag-list (append add-tag-list remove-tag-list)) + (crm-separator " ") + ;; By default, space is bound to "complete word" function. + ;; Re-bind it to insert a space instead. Note that + ;; still does the completion. + (crm-local-completion-map + (let ((map (make-sparse-keymap))) + (set-keymap-parent map crm-local-completion-map) + (define-key map " " 'self-insert-command) + map))) + (delete "" (completing-read-multiple "Tags (+add -drop): " + tag-list nil nil initial-input + 'notmuch-read-tag-changes-history)))) + +(defun notmuch-update-tags (tags tag-changes) + "Return a copy of TAGS with additions and removals from TAG-CHANGES. + +TAG-CHANGES must be a list of tags names, each prefixed with +either a \"+\" to indicate the tag should be added to TAGS if not +present or a \"-\" to indicate that the tag should be removed +from TAGS if present." + (let ((result-tags (copy-sequence tags))) + (dolist (tag-change tag-changes) + (let ((op (string-to-char tag-change)) + (tag (unless (string= tag-change "") (substring tag-change 1)))) + (case op + (?+ (unless (member tag result-tags) + (push tag result-tags))) + (?- (setq result-tags (delete tag result-tags))) + (otherwise + (error "Changed tag must be of the form `+this_tag' or `-that_tag'"))))) + (sort result-tags 'string<))) (defun notmuch-foreach-mime-part (function mm-handle) (cond ((stringp (car mm-handle)) @@ -252,7 +279,7 @@ For a mouse binding, return nil." (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) @@ -401,7 +428,7 @@ any tags). 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 @@ -447,6 +474,10 @@ Complete list of currently available key bindings: "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)) @@ -467,18 +498,14 @@ Complete list of currently available key bindings: "Display the currently selected thread." (interactive "P") (let ((thread-id (notmuch-search-find-thread-id)) - (subject (notmuch-search-find-subject))) + (subject (notmuch-prettify-subject (notmuch-search-find-subject)))) (if (> (length thread-id) 0) - (progn - (if (string-match "^[ \t]*$" subject) - (setq subject "[No Subject]")) - - (notmuch-show thread-id - (current-buffer) - notmuch-search-query-string - ;; Name the buffer based on the subject. - (concat "*" (truncate-string-to-width subject 30 nil nil t) "*") - crypto-switch)) + (notmuch-show thread-id + (current-buffer) + notmuch-search-query-string + ;; Name the buffer based on the subject. + (concat "*" (truncate-string-to-width subject 30 nil nil t) "*") + crypto-switch) (message "End of search results.")))) (defun notmuch-search-reply-to-thread (&optional prompt-for-sender) @@ -510,20 +537,27 @@ and will also appear in a buffer named \"*Notmuch errors*\"." (error (buffer-substring beg end)) )))))) -(defun notmuch-tag (query &rest tags) - "Add/remove tags in TAGS to messages matching QUERY. +(defun notmuch-tag (query &rest tag-changes) + "Add/remove tags in TAG-CHANGES 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. +TAG-CHANGES 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)) + ;; Perform some validation + (mapc (lambda (tag-change) + (unless (string-match-p "^[-+]\\S-+$" tag-change) + (error "Tag must be of the form `+this_tag' or `-that_tag'"))) + tag-changes) + (unless (null tag-changes) + (run-hooks 'notmuch-before-tag-hook) + (apply 'notmuch-call-notmuch-process "tag" + (append tag-changes (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. @@ -569,7 +603,7 @@ the messages that were tagged" (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 @@ -582,74 +616,53 @@ the messages that were tagged" (forward-line 1)) output))) -(defun notmuch-search-add-tag-thread (tag) - (notmuch-search-add-tag-region tag (point) (point))) +(defun notmuch-search-tag-thread (&rest tag-changes) + "Change tags for the currently selected thread. -(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)))))) +See `notmuch-search-tag-region' for details." + (apply 'notmuch-search-tag-region (point) (point) tag-changes)) -(defun notmuch-search-remove-tag-thread (tag) - (notmuch-search-remove-tag-region tag (point) (point))) +(defun notmuch-search-tag-region (beg end &rest tag-changes) + "Change tags for threads in the given region. -(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)) +TAGS is a list of tag operations for `notmuch-tag'. The tags are +added or removed for all threads in the region from BEG to END." + (let ((search-string (notmuch-search-find-thread-id-region-search beg end))) + (apply '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. - -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)))) - -(defun notmuch-search-remove-tag (tag) - "Remove a tag from the currently selected thread or region. +(defun notmuch-search-tag (&optional initial-input) + "Change tags for the currently selected thread or region." + (interactive) + (let* ((beg (if (region-active-p) (region-beginning) (point))) + (end (if (region-active-p) (region-end) (point))) + (search-string (notmuch-search-find-thread-id-region-search beg end)) + (tags (notmuch-read-tag-changes initial-input search-string))) + (apply 'notmuch-search-tag-region beg end tags))) + +(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-thread "-inbox") (notmuch-search-next-thread)) (defvar notmuch-search-process-filter-data nil @@ -686,7 +699,8 @@ This function advances the next thread when finished." (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. @@ -853,7 +867,8 @@ non-authors is found, assume that all of the authors match." (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-show-result date count authors + (notmuch-prettify-subject 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) @@ -872,7 +887,7 @@ non-authors is found, assume that all of the authors match." (goto-char found-target))) (delete-process proc)))) -(defun notmuch-search-operate-all (&rest actions) +(defun notmuch-search-tag-all (&rest tag-changes) "Add/remove tags from all matching messages. This command adds or removes tags from all messages matching the @@ -883,16 +898,8 @@ will prompt for tags to be added or removed. Tags prefixed with Each character of the tag name may consist of alphanumeric characters as well as `_.+-'. " - (interactive (notmuch-select-tags-with-completion - "Operations (+add -drop): notmuch tag " - '("+" "-"))) - ;; Perform some validation - (when (null actions) (error "No operations given")) - (mapc (lambda (action) - (unless (string-match-p "^[-+][-+_.[:word:]]+$" action) - (error "Action must be of the form `+this_tag' or `-that_tag'"))) - actions) - (apply 'notmuch-tag notmuch-search-query-string actions)) + (interactive (notmuch-read-tag-changes)) + (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."