]> git.notmuchmail.org Git - notmuch/blobdiff - emacs/notmuch.el
Merge tag 'debian/0.17-4'
[notmuch] / emacs / notmuch.el
index 6081245560134446ea362b686b1dec17bafec481..047175001c777d0e7fe9dfa26bdb69a0dd668a2d 100644 (file)
@@ -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)
@@ -250,6 +165,7 @@ of its command symbol."
 (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)
@@ -485,14 +401,25 @@ 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.
+
+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"
@@ -524,6 +451,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 +477,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)))
@@ -581,17 +511,20 @@ Returns (TAG-CHANGES REGION-BEGIN REGION-END)."
           (notmuch-search-get-tags-region beg end) prompt initial-input)
          region)))
 
-(defun notmuch-search-tag (tag-changes &optional beg end)
+(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."
+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-thread-id-region-search beg end)))
+  (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)
@@ -811,11 +744,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)))
@@ -859,7 +794,7 @@ See `notmuch-tag' for information on the format of TAG-CHANGES."
   (interactive
    (list (notmuch-read-tag-changes
          (notmuch-search-get-tags-region (point-min) (point-max)) "Tag all")))
-  (notmuch-tag notmuch-search-query-string tag-changes))
+  (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."
@@ -963,7 +898,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")