(require 'notmuch-lib)
(require 'notmuch-tag)
(require 'notmuch-show)
+(require 'notmuch-tree)
(require 'notmuch-mua)
(require 'notmuch-hello)
(require 'notmuch-maildir-fcc)
(mm-save-part p))))
mm-handle))
-(defun notmuch-documentation-first-line (symbol)
- "Return the first line of the documentation string for SYMBOL."
- (let ((doc (documentation symbol)))
- (if doc
- (with-temp-buffer
- (insert (documentation symbol t))
- (goto-char (point-min))
- (let ((beg (point)))
- (end-of-line)
- (buffer-substring beg (point))))
- "")))
-
-(defun notmuch-prefix-key-description (key)
- "Given a prefix key code, return a human-readable string representation.
-
-This is basically just `format-kbd-macro' but we also convert ESC to M-."
- (let ((desc (format-kbd-macro (vector key))))
- (if (string= desc "ESC")
- "M-"
- (concat desc " "))))
-
-(defun notmuch-describe-keymap (keymap ua-keys &optional prefix tail)
- "Return a list of strings, each describing one binding in KEYMAP.
-
-Each string gives a human-readable description of the key and a
-one-line description of the bound function. See `notmuch-help'
-for an overview of how this documentation is extracted.
-
-UA-KEYS should be a key sequence bound to `universal-argument'.
-It will be used to describe bindings of commands that support a
-prefix argument. PREFIX and TAIL are used internally."
- (map-keymap
- (lambda (key binding)
- (cond ((mouse-event-p key) nil)
- ((keymapp binding)
- (setq tail
- (notmuch-describe-keymap
- binding ua-keys (notmuch-prefix-key-description key) tail)))
- (t
- (when (and ua-keys (symbolp binding)
- (get binding 'notmuch-prefix-doc))
- ;; Documentation for prefixed command
- (let ((ua-desc (key-description ua-keys)))
- (push (concat ua-desc " " prefix (format-kbd-macro (vector key))
- "\t" (get binding 'notmuch-prefix-doc))
- tail)))
- ;; Documentation for command
- (push (concat prefix (format-kbd-macro (vector key)) "\t"
- (or (and (symbolp binding) (get binding 'notmuch-doc))
- (notmuch-documentation-first-line binding)))
- tail))))
- keymap)
- tail)
-
-(defun notmuch-substitute-command-keys (doc)
- "Like `substitute-command-keys' but with documentation, not function names."
- (let ((beg 0))
- (while (string-match "\\\\{\\([^}[:space:]]*\\)}" doc beg)
- (let* ((keymap-name (substring doc (match-beginning 1) (match-end 1)))
- (keymap (symbol-value (intern keymap-name)))
- (ua-keys (where-is-internal 'universal-argument keymap t))
- (desc-list (notmuch-describe-keymap keymap ua-keys))
- (desc (mapconcat #'identity desc-list "\n")))
- (setq doc (replace-match desc 1 1 doc)))
- (setq beg (match-end 0)))
- doc))
-
-(defun notmuch-help ()
- "Display help for the current notmuch mode.
-
-This is similar to `describe-function' for the current major
-mode, but bindings tables are shown with documentation strings
-rather than command names. By default, this uses the first line
-of each command's documentation string. A command can override
-this by setting the 'notmuch-doc property of its command symbol.
-A command that supports a prefix argument can explicitly document
-its prefixed behavior by setting the 'notmuch-prefix-doc property
-of its command symbol."
- (interactive)
- (let* ((mode major-mode)
- (doc (substitute-command-keys (notmuch-substitute-command-keys (documentation mode t)))))
- (with-current-buffer (generate-new-buffer "*notmuch-help*")
- (insert doc)
- (goto-char (point-min))
- (set-buffer-modified-p nil)
- (view-buffer (current-buffer) 'kill-buffer-if-not-modified))))
-
(require 'hl-line)
(defun notmuch-hl-line-mode ()
(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 "Z" 'notmuch-tree-from-search-current-query)
map)
"Keymap for \"notmuch search\" buffers.")
(fset 'notmuch-search-mode-map notmuch-search-mode-map)
(defvar notmuch-search-stash-map
(let ((map (make-sparse-keymap)))
(define-key map "i" 'notmuch-search-stash-thread-id)
+ (define-key map "?" 'notmuch-subkeymap-help)
map)
"Submap for stash commands")
(fset 'notmuch-search-stash-map notmuch-search-stash-map)
(let ((thread (plist-get (notmuch-search-get-result) :thread)))
(when thread (concat (unless bare "thread:") thread))))
-(defun notmuch-search-find-thread-id-region (beg end)
- "Return a list of threads for the current region"
- (mapcar (lambda (thread) (concat "thread:" thread))
- (notmuch-search-properties-in-region :thread beg end)))
+(defun notmuch-search-find-stable-query ()
+ "Return the stable queries for the current thread.
+
+This returns a list (MATCHED-QUERY UNMATCHED-QUERY) for the
+matched and unmatched messages in the current thread."
+ (plist-get (notmuch-search-get-result) :query))
-(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-stable-query-region (beg end &optional only-matched)
+ "Return the stable query for the current region.
+
+If ONLY-MATCHED is non-nil, include only matched messages. If it
+is nil, include both matched and unmatched messages."
+ (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)))
+ (concat "(" (mapconcat 'identity query-list ") or (") ")")))
(defun notmuch-search-find-authors ()
"Return the authors for the current thread"
(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"
+ (interactive)
+ (notmuch-tree notmuch-search-query-string))
+
+(defun notmuch-tree-from-search-thread ()
+ "Show the selected thread with notmuch-tree"
+ (interactive)
+ (notmuch-tree (notmuch-search-find-thread-id)
+ notmuch-search-query-string
+ nil
+ (notmuch-prettify-subject (notmuch-search-find-subject))
+ t))
+
(defun notmuch-search-reply-to-thread (&optional prompt-for-sender)
"Begin composing a reply-all to the entire current thread in a new buffer."
(interactive "P")
(let ((message-id (notmuch-search-find-thread-id)))
(notmuch-mua-new-reply message-id prompt-for-sender nil)))
-(defun notmuch-call-notmuch-process (&rest args)
- "Synchronously invoke \"notmuch\" with the given list of arguments.
-
-If notmuch exits with a non-zero status, output from the process
-will appear in a buffer named \"*Notmuch errors*\" and an error
-will be signaled."
- (with-temp-buffer
- (let ((status (apply #'call-process notmuch-command nil t nil args)))
- (notmuch-check-exit-status status (cons notmuch-command args)
- (buffer-string)))))
-
(defun notmuch-search-set-tags (tags &optional pos)
(let ((new-result (plist-put (notmuch-search-get-result pos) :tags tags)))
(notmuch-search-update-result new-result pos)))
(setq output (append output (notmuch-search-get-tags pos)))))
output))
-(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 (notmuch-tag search-string tag-changes))
+(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)))
+
+(defun notmuch-search-tag (tag-changes &optional beg end only-matched)
+ "Change tags for the currently selected thread or region.
+
+See `notmuch-tag' for information on the format of TAG-CHANGES.
+When called interactively, this uses the region if the region is
+active. When called directly, BEG and END provide the region.
+If these are nil or not provided, 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 (point) end (point)))
+ (let ((search-string (notmuch-search-find-stable-query-region
+ beg end only-matched)))
+ (notmuch-tag search-string tag-changes)
(notmuch-search-foreach-result beg end
(lambda (pos)
(notmuch-search-set-tags
(notmuch-update-tags (notmuch-search-get-tags pos) tag-changes)
pos)))))
-(defun notmuch-search-tag (&optional tag-changes)
- "Change tags for the currently selected thread or region.
-
-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))))
- (notmuch-search-tag-region beg end tag-changes)))
-
-(defun notmuch-search-add-tag ()
- "Change tags for the current thread (defaulting to add).
+(defun notmuch-search-add-tag (tag-changes &optional beg end)
+ "Change tags for the current thread or region (defaulting to add).
Same as `notmuch-search-tag' but sets initial input to '+'."
- (interactive)
- (notmuch-search-tag "+"))
+ (interactive (notmuch-search-interactive-tag-changes "+"))
+ (notmuch-search-tag tag-changes beg end))
-(defun notmuch-search-remove-tag ()
- "Change tags for the current thread (defaulting to remove).
+(defun notmuch-search-remove-tag (tag-changes &optional beg end)
+ "Change tags for the current thread or region (defaulting to remove).
Same as `notmuch-search-tag' but sets initial input to '-'."
- (interactive)
- (notmuch-search-tag "-"))
+ (interactive (notmuch-search-interactive-tag-changes "-"))
+ (notmuch-search-tag tag-changes beg end))
(put 'notmuch-search-archive-thread 'notmuch-prefix-doc
"Un-archive the currently selected thread.")
-(defun notmuch-search-archive-thread (&optional unarchive)
- "Archive the currently selected thread.
+(defun notmuch-search-archive-thread (&optional unarchive beg end)
+ "Archive the currently selected thread or region.
Archive each message in the currently selected thread by applying
the tag changes in `notmuch-archive-tags' to each (remove the
`notmuch-archive-tags' will be reversed).
This function advances the next thread when finished."
- (interactive "P")
+ (interactive (cons current-prefix-arg (notmuch-search-interactive-region)))
(when notmuch-archive-tags
(notmuch-search-tag
- (notmuch-tag-change-list notmuch-archive-tags unarchive)))
+ (notmuch-tag-change-list notmuch-archive-tags unarchive) beg end))
(notmuch-search-next-thread))
(defun notmuch-search-update-result (result &optional pos)
(plist-get result :total)))
'face 'notmuch-search-count)))
((string-equal field "subject")
- (insert (propertize (format format-string (plist-get result :subject))
+ (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 (plist-get result :authors)))
+ (notmuch-search-insert-authors
+ format-string (notmuch-sanitize (plist-get result :authors))))
((string-equal field "tags")
(let ((tags (plist-get result :tags)))
(notmuch-sexp-parse-partial-list 'notmuch-search-show-result
results-buf)))))
-(defun notmuch-search-tag-all (&optional tag-changes)
+(defun notmuch-search-tag-all (tag-changes)
"Add/remove tags from all messages in current search buffer.
See `notmuch-tag' for information on the format of TAG-CHANGES."
- (interactive)
- (notmuch-tag notmuch-search-query-string tag-changes))
+ (interactive
+ (list (notmuch-read-tag-changes
+ (notmuch-search-get-tags-region (point-min) (point-max)) "Tag all")))
+ (notmuch-search-tag tag-changes (point-min) (point-max) t))
(defun notmuch-search-buffer-title (query)
"Returns the title for a buffer with notmuch search results."
(save-excursion
(let ((proc (notmuch-start-notmuch
"notmuch-search" buffer #'notmuch-search-process-sentinel
- "search" "--format=sexp" "--format-version=1"
+ "search" "--format=sexp" "--format-version=2"
(if oldest-first
"--sort=oldest-first"
"--sort=newest-first")
projects / notmuch / blobdiff