X-Git-Url: https://git.notmuchmail.org/git?p=notmuch;a=blobdiff_plain;f=emacs%2Fnotmuch.el;h=b44a907a74c7eb7d8ea4320176417a3534d3d55f;hp=03040964ab34a31f13ec7618e3cc8839c70930af;hb=ce44657c9e4919b1e4bbbbbe37dbd72257d40736;hpb=69c52c56f2a7defe03e8e5e2ab470a7eeb4c55fb diff --git a/emacs/notmuch.el b/emacs/notmuch.el index 03040964..b44a907a 100644 --- a/emacs/notmuch.el +++ b/emacs/notmuch.el @@ -36,7 +36,7 @@ ;; ;; Then, to actually run it, add: ;; -;; (require 'notmuch) +;; (autoload 'notmuch "notmuch" "Notmuch mail" t) ;; ;; to your ~/.emacs file, and then run "M-x notmuch" from within emacs, ;; or run: @@ -54,12 +54,17 @@ (require 'notmuch-lib) (require 'notmuch-tag) (require 'notmuch-show) +(require 'notmuch-tree) (require 'notmuch-mua) (require 'notmuch-hello) (require 'notmuch-maildir-fcc) (require 'notmuch-message) (require 'notmuch-parser) +(unless (require 'notmuch-version nil t) + (defconst notmuch-emacs-version "unknown" + "Placeholder variable when notmuch-version.el[c] is not available.")) + (defcustom notmuch-search-result-format `(("date" . "%12s ") ("count" . "%-7s ") @@ -80,6 +85,18 @@ To enter a line break in customize, press \\[quoted-insert] C-j." :type '(alist :key-type (string) :value-type (string)) :group 'notmuch-search) +;; The name of this variable `notmuch-init-file' is consistent with the +;; convention used in e.g. emacs and gnus. The value, `notmuch-config[.el[c]]' +;; is consistent with notmuch cli configuration file `~/.notmuch-config'. +(defcustom notmuch-init-file (locate-user-emacs-file "notmuch-config") + "Your Notmuch Emacs-Lisp configuration file name. +If a file with one of the suffixes defined by `get-load-suffixes' exists, +it will be read instead. +This file is read once when notmuch is loaded; the notmuch hooks added +there will be called at other points of notmuch execution." + :type 'file + :group 'notmuch) + (defvar notmuch-query-history nil "Variable to store minibuffer history for notmuch queries") @@ -119,69 +136,6 @@ To enter a line break in customize, press \\[quoted-insert] C-j." (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 &optional prefix tail) - "Return a list of strings, each describing one key in KEYMAP. - -Each string gives a human-readable description of the key and the -first line of documentation for the bound function." - (map-keymap - (lambda (key binding) - (cond ((mouse-event-p key) nil) - ((keymapp binding) - (setq tail - (notmuch-describe-keymap - binding (notmuch-prefix-key-description key) tail))) - (t - (push (concat prefix (format-kbd-macro (vector key)) "\t" - (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))) - (desc-list (notmuch-describe-keymap keymap)) - (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." - (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 () @@ -198,8 +152,7 @@ first line of documentation for the bound function." (defvar notmuch-search-mode-map (let ((map (make-sparse-keymap))) - (define-key map "?" 'notmuch-help) - (define-key map "q" 'notmuch-kill-this-buffer) + (set-keymap-parent map notmuch-common-keymap) (define-key map "x" 'notmuch-kill-this-buffer) (define-key map (kbd "") 'notmuch-search-scroll-down) (define-key map "b" 'notmuch-search-scroll-down) @@ -210,12 +163,8 @@ first line of documentation for the bound function." (define-key map "n" 'notmuch-search-next-thread) (define-key map "r" 'notmuch-search-reply-to-thread-sender) (define-key map "R" 'notmuch-search-reply-to-thread) - (define-key map "m" 'notmuch-mua-new-mail) - (define-key map "s" 'notmuch-search) (define-key map "o" 'notmuch-search-toggle-order) (define-key map "c" 'notmuch-search-stash-map) - (define-key map "=" 'notmuch-refresh-this-buffer) - (define-key map "G" 'notmuch-poll-and-refresh-this-buffer) (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) @@ -224,6 +173,7 @@ first line of documentation for the bound function." (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) @@ -231,6 +181,7 @@ first line of documentation for the bound function." (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) @@ -466,14 +417,27 @@ 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)))) -(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. -(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 ")) +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-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. 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 query-list + (concat "(" (mapconcat 'identity query-list ") or (") ")")))) (defun notmuch-search-find-authors () "Return the authors for the current thread" @@ -491,19 +455,34 @@ If BARE is set then do not prefix with \"thread:\"" "Return a list of authors for the current region" (notmuch-search-properties-in-region :subject beg end)) -(defun notmuch-search-show-thread () +(defun notmuch-search-show-thread (&optional elide-toggle) "Display the currently selected thread." - (interactive) + (interactive "P") (let ((thread-id (notmuch-search-find-thread-id)) (subject (notmuch-search-find-subject))) (if (> (length thread-id) 0) (notmuch-show thread-id + 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) "*")) (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") @@ -516,17 +495,6 @@ If BARE is set then do not prefix with \"thread:\"" (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))) @@ -541,37 +509,65 @@ will be signaled." (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. +(defun notmuch-search-add-tag (tag-changes &optional beg end) + "Change tags for the current thread or region (defaulting to add). -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))) +Same as `notmuch-search-tag' but sets initial input to '+'." + (interactive (notmuch-search-interactive-tag-changes "+")) + (notmuch-search-tag tag-changes beg end)) -(defun notmuch-search-add-tag () - "Same as `notmuch-search-tag' but sets initial input to '+'." - (interactive) - (notmuch-search-tag "+")) +(defun notmuch-search-remove-tag (tag-changes &optional beg end) + "Change tags for the current thread or region (defaulting to remove). -(defun notmuch-search-remove-tag () - "Same as `notmuch-search-tag' but sets initial input to '-'." - (interactive) - (notmuch-search-tag "-")) +Same as `notmuch-search-tag' but sets initial input to '-'." + (interactive (notmuch-search-interactive-tag-changes "-")) + (notmuch-search-tag tag-changes beg end)) -(defun notmuch-search-archive-thread (&optional unarchive) - "Archive the currently selected thread. +(put 'notmuch-search-archive-thread 'notmuch-prefix-doc + "Un-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 @@ -580,11 +576,12 @@ 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 "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-search-next-thread)) + (notmuch-tag-change-list notmuch-archive-tags unarchive) beg end)) + (when (eq beg end) + (notmuch-search-next-thread))) (defun notmuch-search-update-result (result &optional pos) "Replace the result object of the thread at POS (or point) by @@ -653,12 +650,12 @@ of the result." 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 '((\"deleted\" . (:foreground \"red\" - :background \"blue\")) - (\"unread\" . (:foreground \"green\")))) + (setq notmuch-search-line-faces '((\"unread\" . (:foreground \"green\")) + (\"deleted\" . (:foreground \"red\" + :background \"blue\")))) -The attributes defined for matching tags are merged, with later -attributes overriding earlier. A message having both \"deleted\" +The attributes defined for matching tags are merged, with earlier +attributes overriding later. 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)) @@ -671,7 +668,7 @@ foreground and blue background." (let ((tag (car elem)) (attributes (cdr elem))) (when (member tag line-tag-list) - (notmuch-combine-face-text-property start end attributes)))) + (notmuch-apply-face nil attributes nil start end)))) ;; Reverse the list so earlier entries take precedence (reverse notmuch-search-line-faces))) @@ -766,31 +763,42 @@ non-authors is found, assume that all of the authors match." (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))) - (insert (format format-string (notmuch-tag-format-tags tags))))))) + (let ((tags (plist-get result :tags)) + (orig-tags (plist-get result :orig-tags))) + (insert (format format-string (notmuch-tag-format-tags tags orig-tags))))))) -(defun notmuch-search-show-result (result &optional pos) - "Insert RESULT at POS or the end of the buffer if POS is null." +(defun notmuch-search-show-result (result pos) + "Insert RESULT at POS." ;; Ignore excluded matches (unless (= (plist-get result :matched) 0) - (let ((beg (or pos (point-max)))) - (save-excursion - (goto-char beg) - (dolist (spec notmuch-search-result-format) - (notmuch-search-insert-field (car spec) (cdr spec) result)) - (insert "\n") - (notmuch-search-color-line beg (point) (plist-get result :tags)) - (put-text-property beg (point) 'notmuch-search-result result)) - (when (string= (plist-get result :thread) notmuch-search-target-thread) - (setq notmuch-search-target-thread "found") - (goto-char beg))))) + (save-excursion + (goto-char pos) + (dolist (spec notmuch-search-result-format) + (notmuch-search-insert-field (car spec) (cdr spec) result)) + (insert "\n") + (notmuch-search-color-line pos (point) (plist-get result :tags)) + (put-text-property pos (point) 'notmuch-search-result result)))) + +(defun notmuch-search-append-result (result) + "Insert RESULT at the end of the buffer. + +This is only called when a result is first inserted so it also +sets the :orig-tag property." + (let ((new-result (plist-put result :orig-tags (plist-get result :tags))) + (pos (point-max))) + (notmuch-search-show-result new-result pos) + (when (string= (plist-get result :thread) notmuch-search-target-thread) + (setq notmuch-search-target-thread "found") + (goto-char pos)))) (defun notmuch-search-process-filter (proc string) "Process and filter the output of \"notmuch search\"" @@ -804,15 +812,17 @@ non-authors is found, assume that all of the authors match." (save-excursion (goto-char (point-max)) (insert string)) - (notmuch-sexp-parse-partial-list 'notmuch-search-show-result + (notmuch-sexp-parse-partial-list 'notmuch-search-append-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) - (apply '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." @@ -820,14 +830,14 @@ See `notmuch-tag' for information on the format of TAG-CHANGES." (let (longest (longest-length 0)) (loop for tuple in notmuch-saved-searches - if (let ((quoted-query (regexp-quote (cdr tuple)))) + 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 (car saved-search)) - (saved-search-query (cdr saved-search))) + (saved-search-name (notmuch-saved-search-get saved-search :name)) + (saved-search-query (notmuch-saved-search-get saved-search :query))) (cond ((and saved-search (equal saved-search-query query)) ;; Query is the same as saved search (ignoring case) (concat "*notmuch-saved-search-" saved-search-name "*")) @@ -847,12 +857,16 @@ See `notmuch-tag' for information on the format of TAG-CHANGES." PROMPT is the string to prompt with." (lexical-let ((completions - (append (list "folder:" "thread:" "id:" "date:" "from:" "to:" + (append (list "folder:" "path:" "thread:" "id:" "date:" "from:" "to:" "subject:" "attachment:") (mapcar (lambda (tag) (concat "tag:" (notmuch-escape-boolean-term tag))) (process-lines notmuch-command "search" "--output=tags" "*"))))) (let ((keymap (copy-keymap minibuffer-local-map)) + (current-query (case major-mode + (notmuch-search-mode (notmuch-search-get-query)) + (notmuch-show-mode (notmuch-show-get-query)) + (notmuch-tree-mode (notmuch-tree-get-query)))) (minibuffer-completion-table (completion-table-dynamic (lambda (string) @@ -870,19 +884,24 @@ PROMPT is the string to prompt with." (define-key keymap (kbd "TAB") 'minibuffer-complete) (let ((history-delete-duplicates t)) (read-from-minibuffer prompt nil keymap nil - 'notmuch-search-history nil nil))))) + 'notmuch-search-history current-query nil))))) + +(defun notmuch-search-get-query () + "Return the current query in this search buffer" + notmuch-search-query-string) ;;;###autoload +(put 'notmuch-search 'notmuch-doc "Search for messages.") (defun notmuch-search (&optional query oldest-first target-thread target-line) - "Run \"notmuch search\" with the given `query' and display results. + "Display threads matching QUERY in a notmuch-search buffer. -If `query' is nil, it is read interactively from the minibuffer. +If QUERY is nil, it is read interactively from the minibuffer. Other optional parameters are used as follows: - oldest-first: A Boolean controlling the sort order of returned threads - target-thread: A thread ID (without the thread: prefix) that will be made + OLDEST-FIRST: A Boolean controlling the sort order of returned threads + TARGET-THREAD: A thread ID (without the thread: prefix) that will be made current if it appears in the search results. - target-line: The line number to move to if the target thread does not + TARGET-LINE: The line number to move to if the target thread does not appear in the search results. When called interactively, this will prompt for a query and use @@ -893,7 +912,7 @@ the configured default sort order." nil ;; Use the default search order (if we're doing a search from a ;; search buffer, ignore any buffer-local overrides) - (default-value notmuch-search-oldest-first))) + (default-value 'notmuch-search-oldest-first))) (let* ((query (or query (notmuch-read-query "Notmuch search: "))) (buffer (get-buffer-create (notmuch-search-buffer-title query)))) @@ -905,6 +924,7 @@ the configured default sort order." (set 'notmuch-search-oldest-first oldest-first) (set 'notmuch-search-target-thread target-thread) (set 'notmuch-search-target-line target-line) + (notmuch-tag-clear-cache) (let ((proc (get-buffer-process (current-buffer))) (inhibit-read-only t)) (if proc @@ -915,7 +935,7 @@ the configured default sort order." (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") @@ -1020,3 +1040,9 @@ notmuch buffers exist, run `notmuch'." (setq mail-user-agent 'notmuch-user-agent) (provide 'notmuch) + +;; 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))))