X-Git-Url: https://git.notmuchmail.org/git?a=blobdiff_plain;f=emacs%2Fnotmuch.el;h=b11ef60bcfa55cb1b42c61280d6ab0762d09c89c;hb=662e097984780165e57c7fa1f0ddf450dfeab83d;hp=6081245560134446ea362b686b1dec17bafec481;hpb=22172daa1768fff08046b4ccb82ceb2f3a38ac30;p=notmuch diff --git a/emacs/notmuch.el b/emacs/notmuch.el index 60812455..b11ef60b 100644 --- a/emacs/notmuch.el +++ b/emacs/notmuch.el @@ -54,6 +54,7 @@ (require 'notmuch-lib) (require 'notmuch-tag) (require 'notmuch-show) +(require 'notmuch-tree) (require 'notmuch-mua) (require 'notmuch-hello) (require 'notmuch-maildir-fcc) @@ -119,93 +120,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 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 () @@ -243,6 +157,7 @@ of its command symbol." (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) @@ -524,6 +439,20 @@ If BARE is set then do not prefix with \"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") @@ -536,17 +465,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))) @@ -811,11 +729,13 @@ 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)))