X-Git-Url: https://git.notmuchmail.org/git?p=notmuch;a=blobdiff_plain;f=emacs%2Fnotmuch.el;h=a980c7a212358a9e54943d90b1a3b4bcbd9e3e45;hp=44402f8aa8256b55816b9a256b6b7f7468e54e9d;hb=11ac932a4503872c19987b843d58513c4b9ef76f;hpb=65b17dab461ef847b418aff69bc53e697ec2d20b diff --git a/emacs/notmuch.el b/emacs/notmuch.el index 44402f8a..a980c7a2 100644 --- a/emacs/notmuch.el +++ b/emacs/notmuch.el @@ -65,7 +65,8 @@ ;; ;;; Code: -(eval-when-compile (require 'cl)) +(eval-when-compile (require 'cl-lib)) + (require 'mm-view) (require 'message) @@ -132,7 +133,7 @@ there will be called at other points of notmuch execution." (or (equal (car disposition) "attachment") (and (equal (car disposition) "inline") (assq 'filename disposition))) - (incf count)))) + (cl-incf count)))) mm-handle) count)) @@ -188,7 +189,9 @@ there will be called at other points of notmuch execution." (define-key map "-" 'notmuch-search-remove-tag) (define-key map "+" 'notmuch-search-add-tag) (define-key map (kbd "RET") 'notmuch-search-show-thread) + (define-key map (kbd "M-RET") 'notmuch-tree-from-search-thread) (define-key map "Z" 'notmuch-tree-from-search-current-query) + (define-key map "U" 'notmuch-unthreaded-from-search-current-query) map) "Keymap for \"notmuch search\" buffers.") (fset 'notmuch-search-mode-map notmuch-search-mode-map) @@ -427,14 +430,13 @@ character position of the beginning of each result that overlaps the region between points BEG and END. As a special case, if (= BEG END), FN will be applied to the result containing point BEG." - - (lexical-let ((pos (notmuch-search-result-beginning beg)) - ;; End must be a marker in case fn changes the - ;; text. - (end (copy-marker end)) - ;; Make sure we examine at least one result, even if - ;; (= beg end). - (first t)) + (let ((pos (notmuch-search-result-beginning beg)) + ;; End must be a marker in case fn changes the + ;; text. + (end (copy-marker end)) + ;; Make sure we examine at least one result, even if + ;; (= beg end). + (first t)) ;; We have to be careful if the region extends beyond the results. ;; In this case, pos could be null or there could be no result at ;; pos. @@ -476,10 +478,10 @@ is nil, include both matched and unmatched messages. If there are no messages in the region then return nil." (let ((query-list nil) (all (not only-matched))) (dolist (queries (notmuch-search-properties-in-region :query beg end)) - (when (first queries) - (push (first queries) query-list)) - (when (and all (second queries)) - (push (second queries) query-list))) + (when (car queries) + (push (car queries) query-list)) + (when (and all (cadr queries)) + (push (cadr queries) query-list))) (when query-list (concat "(" (mapconcat 'identity query-list ") or (") ")")))) @@ -522,6 +524,11 @@ thread." (interactive) (notmuch-tree notmuch-search-query-string)) +(defun notmuch-unthreaded-from-search-current-query () + "Call notmuch tree with the current query" + (interactive) + (notmuch-unthreaded notmuch-search-query-string)) + (defun notmuch-tree-from-search-thread () "Show the selected thread with notmuch-tree" (interactive) @@ -557,25 +564,15 @@ thread." (setq output (append output (notmuch-search-get-tags pos))))) output)) -(defun notmuch-search-interactive-region () - "Return the bounds of the current interactive region. - -This returns (BEG END), where BEG and END are the bounds of the -region if the region is active, or both `point' otherwise." - (if (region-active-p) - (list (region-beginning) (region-end)) - (list (point) (point)))) - (defun notmuch-search-interactive-tag-changes (&optional initial-input) "Prompt for tag changes for the current thread or region. Returns (TAG-CHANGES REGION-BEGIN REGION-END)." - (let* ((region (notmuch-search-interactive-region)) - (beg (first region)) (end (second region)) - (prompt (if (= beg end) "Tag thread" "Tag region"))) - (cons (notmuch-read-tag-changes - (notmuch-search-get-tags-region beg end) prompt initial-input) - region))) + (pcase-let ((`(,beg ,end) (notmuch-interactive-region))) + (list (notmuch-read-tag-changes (notmuch-search-get-tags-region beg end) + (if (= beg end) "Tag thread" "Tag region") + initial-input) + beg end))) (defun notmuch-search-tag (tag-changes &optional beg end only-matched) "Change tags for the currently selected thread or region. @@ -590,8 +587,8 @@ is inactive this applies to the thread at point. If ONLY-MATCHED is non-nil, only tag matched messages." (interactive (notmuch-search-interactive-tag-changes)) (unless (and beg end) - (setq beg (car (notmuch-search-interactive-region)) - end (cadr (notmuch-search-interactive-region)))) + (setq beg (car (notmuch-interactive-region)) + end (cadr (notmuch-interactive-region)))) (let ((search-string (notmuch-search-find-stable-query-region beg end only-matched))) (notmuch-tag search-string tag-changes) @@ -627,7 +624,7 @@ messages will be \"unarchived\" (i.e. the tag changes in `notmuch-archive-tags' will be reversed). This function advances the next thread when finished." - (interactive (cons current-prefix-arg (notmuch-search-interactive-region))) + (interactive (cons current-prefix-arg (notmuch-interactive-region))) (when notmuch-archive-tags (notmuch-search-tag (notmuch-tag-change-list notmuch-archive-tags unarchive) beg end)) @@ -711,7 +708,7 @@ A thread with TAG will have FACE applied. 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 '((\"unread\" . (:foreground \"green\")) + (setq notmuch-search-line-faces \\='((\"unread\" . (:foreground \"green\")) (\"deleted\" . (:foreground \"red\" :background \"blue\")))) @@ -893,12 +890,13 @@ See `notmuch-tag' for information on the format of TAG-CHANGES." (let* ((saved-search (let (longest (longest-length 0)) - (loop for tuple in notmuch-saved-searches - if (let ((quoted-query (regexp-quote (notmuch-saved-search-get tuple :query)))) - (and (string-match (concat "^" quoted-query) query) - (> (length (match-string 0 query)) - longest-length))) - do (setq longest tuple)) + (cl-loop for tuple in notmuch-saved-searches + if (let ((quoted-query + (regexp-quote (notmuch-saved-search-get tuple :query)))) + (and (string-match (concat "^" quoted-query) query) + (> (length (match-string 0 query)) + longest-length))) + do (setq longest tuple)) longest)) (saved-search-name (notmuch-saved-search-get saved-search :name)) (saved-search-query (notmuch-saved-search-get saved-search :query))) @@ -919,7 +917,7 @@ See `notmuch-tag' for information on the format of TAG-CHANGES." "Read a notmuch-query from the minibuffer with completion. PROMPT is the string to prompt with." - (lexical-let* + (let* ((all-tags (mapcar (lambda (tag) (notmuch-escape-boolean-term tag)) (process-lines notmuch-command "search" "--output=tags" "*"))) @@ -930,7 +928,7 @@ PROMPT is the string to prompt with." (mapcar (lambda (tag) (concat "is:" tag)) all-tags) (mapcar (lambda (mimetype) (concat "mimetype:" mimetype)) (mailcap-mime-types))))) (let ((keymap (copy-keymap minibuffer-local-map)) - (current-query (case major-mode + (current-query (cl-case major-mode (notmuch-search-mode (notmuch-search-get-query)) (notmuch-show-mode (notmuch-show-get-query)) (notmuch-tree-mode (notmuch-tree-get-query)))) @@ -1076,9 +1074,15 @@ current search results AND the additional query string provided." Runs a new search matching only messages that match both the current search results AND that are tagged with the given tag." (interactive - (list (notmuch-select-tag-with-completion "Filter by tag: "))) + (list (notmuch-select-tag-with-completion "Filter by tag: " notmuch-search-query-string))) (notmuch-search (concat notmuch-search-query-string " and tag:" tag) notmuch-search-oldest-first)) +(defun notmuch-search-by-tag (tag) + "Display threads matching TAG in a notmuch-search buffer." + (interactive + (list (notmuch-select-tag-with-completion "Notmuch search tag: "))) + (notmuch-search (concat "tag:" tag))) + ;;;###autoload (defun notmuch () "Run notmuch and display saved searches, known tags, etc." @@ -1110,9 +1114,9 @@ notmuch buffers exist, run `notmuch'." (bury-buffer)) ;; Find the first notmuch buffer. - (setq first (loop for buffer in (buffer-list) - if (notmuch-interesting-buffer buffer) - return buffer)) + (setq first (cl-loop for buffer in (buffer-list) + if (notmuch-interesting-buffer buffer) + return buffer)) (if first ;; If the first one we found is any other than the starting