;;
;;; Code:
-(eval-when-compile (require 'cl))
+(eval-when-compile (require 'cl-lib))
+
(require 'mm-view)
(require 'message)
:group 'notmuch)
(defvar notmuch-query-history nil
- "Variable to store minibuffer history for notmuch queries")
+ "Variable to store minibuffer history for notmuch queries.")
(defun notmuch-foreach-mime-part (function mm-handle)
(cond ((stringp (car mm-handle))
- (dolist (part (cdr mm-handle))
- (notmuch-foreach-mime-part function part)))
- ((bufferp (car mm-handle))
- (funcall function mm-handle))
- (t (dolist (part mm-handle)
- (notmuch-foreach-mime-part function part)))))
+ (dolist (part (cdr mm-handle))
+ (notmuch-foreach-mime-part function part)))
+ ((bufferp (car mm-handle))
+ (funcall function mm-handle))
+ (t (dolist (part mm-handle)
+ (notmuch-foreach-mime-part function part)))))
(defun notmuch-count-attachments (mm-handle)
(let ((count 0))
(notmuch-foreach-mime-part
(lambda (p)
(let ((disposition (mm-handle-disposition p)))
- (and (listp disposition)
- (or (equal (car disposition) "attachment")
- (and (equal (car disposition) "inline")
- (assq 'filename disposition)))
- (incf count))))
+ (and (listp disposition)
+ (or (equal (car disposition) "attachment")
+ (and (equal (car disposition) "inline")
+ (assq 'filename disposition)))
+ (cl-incf count))))
mm-handle)
count))
(lambda (p)
(let ((disposition (mm-handle-disposition p)))
(and (listp disposition)
- (or (equal (car disposition) "attachment")
- (and (equal (car disposition) "inline")
- (assq 'filename disposition)))
- (or (not queryp)
- (y-or-n-p
- (concat "Save '" (cdr (assq 'filename disposition)) "' ")))
- (mm-save-part p))))
+ (or (equal (car disposition) "attachment")
+ (and (equal (car disposition) "inline")
+ (assq 'filename disposition)))
+ (or (not queryp)
+ (y-or-n-p
+ (concat "Save '" (cdr (assq 'filename disposition)) "' ")))
+ (mm-save-part p))))
mm-handle))
(require 'hl-line)
(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)
(define-key map "q" 'notmuch-stash-query)
(define-key map "?" 'notmuch-subkeymap-help)
map)
- "Submap for stash commands")
+ "Submap for stash commands.")
(fset 'notmuch-search-stash-map notmuch-search-stash-map)
(defun notmuch-search-stash-thread-id ()
(goto-char (point-min)))
(defface notmuch-message-summary-face
- '((((class color) (background light)) (:background "#f0f0f0"))
- (((class color) (background dark)) (:background "#303030")))
- "Face for the single-line message summary in notmuch-show-mode."
- :group 'notmuch-show
- :group 'notmuch-faces)
+ '((((class color) (background light)) (:background "#f0f0f0"))
+ (((class color) (background dark)) (:background "#303030")))
+ "Face for the single-line message summary in notmuch-show-mode."
+ :group 'notmuch-show
+ :group 'notmuch-faces)
(defface notmuch-search-date
'((t :inherit default))
(setq truncate-lines t)
(setq buffer-read-only t)
(setq imenu-prev-index-position-function
- #'notmuch-search-imenu-prev-index-position-function)
+ #'notmuch-search-imenu-prev-index-position-function)
(setq imenu-extract-index-name-function
- #'notmuch-search-imenu-extract-index-name-function))
+ #'notmuch-search-imenu-extract-index-name-function))
(defun notmuch-search-get-result (&optional pos)
"Return the result object for the thread at POS (or point).
The returned point will be just after the newline character that
ends the result line. If there is no thread at POS (or point),
-returns nil"
+returns nil."
(when (notmuch-search-get-result pos)
(next-single-property-change (or pos (point)) 'notmuch-search-result
nil (point-max))))
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.
output))
(defun notmuch-search-find-thread-id (&optional bare)
- "Return the thread for the current thread
+ "Return the thread for the current thread.
-If BARE is set then do not prefix with \"thread:\""
+If BARE is set then do not prefix with \"thread:\"."
(let ((thread (plist-get (notmuch-search-get-result) :thread)))
(when thread (concat (unless bare "thread:") thread))))
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 (") ")"))))
(defun notmuch-search-find-authors ()
- "Return the authors for the current thread"
+ "Return the authors for the current thread."
(plist-get (notmuch-search-get-result) :authors))
(defun notmuch-search-find-authors-region (beg end)
- "Return a list of authors for the current region"
+ "Return a list of authors for the current region."
(notmuch-search-properties-in-region :authors beg end))
(defun notmuch-search-find-subject ()
- "Return the subject for the current thread"
+ "Return the subject for the current thread."
(plist-get (notmuch-search-get-result) :subject))
(defun notmuch-search-find-subject-region (beg end)
- "Return a list of authors for the current region"
+ "Return a list of authors for the current region."
(notmuch-search-properties-in-region :subject beg end))
(defun notmuch-search-show-thread (&optional elide-toggle)
(current-buffer)
notmuch-search-query-string
;; Name the buffer based on the subject.
- (concat "*" (truncate-string-to-width subject 30 nil nil t) "*"))
+ (concat "*"
+ (truncate-string-to-width subject 30 nil nil t)
+ "*"))
(message "End of search results."))))
(defun notmuch-tree-from-search-current-query ()
- "Call notmuch tree with the current query"
+ "Call notmuch tree with the current query."
(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"
+ "Show the selected thread with notmuch-tree."
(interactive)
(notmuch-tree (notmuch-search-find-thread-id)
- notmuch-search-query-string
+ notmuch-search-query-string
nil
- (notmuch-prettify-subject (notmuch-search-find-subject))
+ (notmuch-prettify-subject (notmuch-search-find-subject))
t))
(defun notmuch-search-reply-to-thread (&optional prompt-for-sender)
(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.
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)
`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))
(goto-char new-point)))))
(defun notmuch-search-process-sentinel (proc msg)
- "Add a message to let user know when \"notmuch search\" exits"
+ "Add a message to let user know when \"notmuch search\" exits."
(let ((buffer (process-buffer proc))
(status (process-status proc))
(exit-status (process-exit-status proc))
(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)))))))))
+ notmuch-search-target-line)
+ (goto-char (point-min))
+ (forward-line (1- notmuch-search-target-line)))))))))
(define-widget 'notmuch--custom-face-edit 'lazy
"Custom face edit with a tag Edit Face"
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\"))
- (\"deleted\" . (:foreground \"red\"
+ (setq notmuch-search-line-faces \\='((\"unread\" . (:foreground \"green\"))
+ (\"deleted\" . (:foreground \"red\"
:background \"blue\"))))
The FACE must be a face name (a symbol or string), a property
background."
:type '(alist :key-type (string)
:value-type (radio (face :tag "Face name")
- (notmuch--custom-face-edit)))
+ (notmuch--custom-face-edit)))
:group 'notmuch-search
:group 'notmuch-faces)
(visible-string formatted-authors)
(invisible-string "")
(padding ""))
-
;; Truncate the author string to fit the specification.
(if (> (length formatted-authors)
(length formatted-sample))
(length visible-string)
(length "..."))
? ))))
-
;; Use different faces to show matching and non-matching authors.
(if (string-match "\\(.*\\)|\\(.*\\)" visible-string)
;; The visible string contains both matching and
;; The invisible string may contain both matching and
;; non-matching authors.
invisible-string (notmuch-search-author-propertize invisible-string)))
-
;; If there is any invisible text, add it as a tooltip to the
;; visible text.
(when (not (string= invisible-string ""))
- (setq visible-string (propertize visible-string 'help-echo (concat "..." invisible-string))))
-
+ (setq visible-string
+ (propertize visible-string
+ 'help-echo (concat "..." invisible-string))))
;; Insert the visible and, if present, invisible author strings.
(insert visible-string)
(when (not (string= invisible-string ""))
(insert (propertize (format format-string
(notmuch-sanitize (plist-get result :subject)))
'face 'notmuch-search-subject)))
-
((string-equal field "authors")
(notmuch-search-insert-authors
format-string (notmuch-sanitize (plist-get result :authors))))
-
((string-equal field "tags")
(let ((tags (plist-get result :tags))
(orig-tags (plist-get result :orig-tags)))
(goto-char pos))))
(defun notmuch-search-process-filter (proc string)
- "Process and filter the output of \"notmuch search\""
+ "Process and filter the output of \"notmuch search\"."
(let ((results-buf (process-buffer proc))
(parse-buf (process-get proc 'parse-buf))
(inhibit-read-only t)
(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)))
(concat "*notmuch-saved-search-" saved-search-name "*"))
(saved-search
(concat "*notmuch-search-"
- (replace-regexp-in-string (concat "^" (regexp-quote saved-search-query))
- (concat "[ " saved-search-name " ]")
- query)
+ (replace-regexp-in-string
+ (concat "^" (regexp-quote saved-search-query))
+ (concat "[ " saved-search-name " ]")
+ query)
"*"))
(t
(concat "*notmuch-search-" query "*"))
"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" "*")))
+ (mapcar (lambda (tag) (notmuch-escape-boolean-term tag))
+ (process-lines notmuch-command "search" "--output=tags" "*")))
(completions
- (append (list "folder:" "path:" "thread:" "id:" "date:" "from:" "to:"
- "subject:" "attachment:")
- (mapcar (lambda (tag) (concat "tag:" tag)) all-tags)
- (mapcar (lambda (tag) (concat "is:" tag)) all-tags)
- (mapcar (lambda (mimetype) (concat "mimetype:" mimetype)) (mailcap-mime-types)))))
+ (append (list "folder:" "path:" "thread:" "id:" "date:" "from:" "to:"
+ "subject:" "attachment:")
+ (mapcar (lambda (tag) (concat "tag:" tag)) all-tags)
+ (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))))
'notmuch-search-history current-query nil)))))
(defun notmuch-search-get-query ()
- "Return the current query in this search buffer"
+ "Return the current query in this search buffer."
notmuch-search-query-string)
(put 'notmuch-search 'notmuch-doc "Search for messages.")
(if no-display
(set-buffer buffer)
(switch-to-buffer buffer))
- (notmuch-search-mode)
+ ;; avoid wiping out third party buffer-local variables in the case
+ ;; where we're just refreshing or changing the sort order of an
+ ;; existing search results buffer
+ (unless (eq major-mode 'notmuch-search-mode)
+ (notmuch-search-mode))
;; Don't track undo information for this buffer
(set 'buffer-undo-list t)
(set 'notmuch-search-query-string query)
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: ")))
- (notmuch-search (concat notmuch-search-query-string " and tag:" tag) notmuch-search-oldest-first))
+ (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 ()
If the current buffer is the only notmuch buffer, bury it. If no
notmuch buffers exist, run `notmuch'."
(interactive)
-
(let (start first)
;; If the current buffer is a notmuch buffer, remember it and then
;; bury it.
(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
;; After provide to avoid loops if notmuch was require'd via notmuch-init-file.
(if init-file-user ; don't load init file if the -q option was used.
- (let ((init-file (locate-file notmuch-init-file '("/")
- (get-load-suffixes))))
- (if init-file (load init-file nil t t))))
+ (load notmuch-init-file t t nil t))
;;; notmuch.el ends here