]> git.notmuchmail.org Git - notmuch/blobdiff - contrib/notmuch-pick/notmuch-pick.el
contrib: pick: add docstring for notmuch-pick-worker
[notmuch] / contrib / notmuch-pick / notmuch-pick.el
index 37dc161e544ab5fb37cfd114d10a5d961111c499..5dcc9426b5aa61df1e4c4d7331f504c21034376b 100644 (file)
   :type '(alist :key-type (string) :value-type (string))
   :group 'notmuch-pick)
 
-(defcustom notmuch-pick-asynchronous-parser t
-  "Use the asynchronous parser."
-  :type 'boolean
-  :group 'notmuch-pick)
-
 ;; Faces for messages that match the query.
 (defface notmuch-pick-match-date-face
   '((t :inherit default))
   "A buffer local copy of argument open-target to the function notmuch-pick")
 (make-variable-buffer-local 'notmuch-pick-open-target)
 
-(defvar notmuch-pick-buffer-name nil
-  "A buffer local copy of argument buffer-name to the function notmuch-pick")
-(make-variable-buffer-local 'notmuch-pick-buffer-name)
-
 (defvar notmuch-pick-message-window nil
   "The window of the message pane.
 
@@ -246,6 +237,7 @@ FUNC."
     ;; The main pick bindings
     (define-key map "q" 'notmuch-pick-quit)
     (define-key map "x" 'notmuch-pick-quit)
+    (define-key map "A" 'notmuch-pick-archive-thread)
     (define-key map "a" 'notmuch-pick-archive-message-then-next)
     (define-key map "=" 'notmuch-pick-refresh-view)
     (define-key map "s" 'notmuch-pick-to-search)
@@ -254,8 +246,11 @@ FUNC."
     (define-key map "p" 'notmuch-pick-prev-matching-message)
     (define-key map "N" 'notmuch-pick-next-message)
     (define-key map "P" 'notmuch-pick-prev-message)
+    (define-key map (kbd "M-p") 'notmuch-pick-prev-thread)
+    (define-key map (kbd "M-n") 'notmuch-pick-next-thread)
     (define-key map "-" 'notmuch-pick-remove-tag)
     (define-key map "+" 'notmuch-pick-add-tag)
+    (define-key map "*" 'notmuch-pick-tag-thread)
     (define-key map " " 'notmuch-pick-scroll-or-next)
     (define-key map "b" 'notmuch-pick-scroll-message-window-back)
     map))
@@ -591,13 +586,70 @@ message will be \"unarchived\", i.e. the tag changes in
   (let ((inhibit-read-only t)
        (basic-query notmuch-pick-basic-query)
        (query-context notmuch-pick-query-context)
-       (target (notmuch-pick-get-message-id))
-       (buffer-name notmuch-pick-buffer-name))
+       (target (notmuch-pick-get-message-id)))
     (erase-buffer)
     (notmuch-pick-worker basic-query
                         query-context
-                        target
-                        (get-buffer buffer-name))))
+                        target)))
+
+(defun notmuch-pick-thread-top ()
+  (when (notmuch-pick-get-message-properties)
+    (while (not (or (notmuch-pick-get-prop :first) (eobp)))
+      (forward-line -1))))
+
+(defun notmuch-pick-prev-thread ()
+  (interactive)
+  (forward-line -1)
+  (notmuch-pick-thread-top))
+
+(defun notmuch-pick-next-thread ()
+  (interactive)
+  (forward-line 1)
+  (while (not (or (notmuch-pick-get-prop :first) (eobp)))
+    (forward-line 1)))
+
+(defun notmuch-pick-thread-mapcar (function)
+  "Iterate through all messages in the current thread
+ and call FUNCTION for side effects."
+  (save-excursion
+    (notmuch-pick-thread-top)
+    (loop collect (funcall function)
+         do (forward-line)
+         while (and (notmuch-pick-get-message-properties)
+                    (not (notmuch-pick-get-prop :first))))))
+
+(defun notmuch-pick-get-messages-ids-thread-search ()
+  "Return a search string for all message ids of messages in the current thread."
+  (mapconcat 'identity
+            (notmuch-pick-thread-mapcar 'notmuch-pick-get-message-id)
+            " or "))
+
+(defun notmuch-pick-tag-thread (&optional tag-changes)
+  "Tag all messages in the current thread"
+  (interactive)
+  (when (notmuch-pick-get-message-properties)
+    (let ((tag-changes (notmuch-tag (notmuch-pick-get-messages-ids-thread-search) tag-changes)))
+      (notmuch-pick-thread-mapcar
+       (lambda () (notmuch-pick-tag-update-display tag-changes))))))
+
+(defun notmuch-pick-archive-thread (&optional unarchive)
+  "Archive each message in thread.
+
+Archive each message currently shown by applying the tag changes
+in `notmuch-archive-tags' to each. If a prefix argument is given,
+the messages will be \"unarchived\", i.e. the tag changes in
+`notmuch-archive-tags' will be reversed.
+
+Note: This command is safe from any race condition of new messages
+being delivered to the same thread. It does not archive the
+entire thread, but only the messages shown in the current
+buffer."
+  (interactive "P")
+  (when notmuch-archive-tags
+    (notmuch-pick-tag-thread
+     (notmuch-tag-change-list notmuch-archive-tags unarchive))))
+
+;; Functions below here display the pick buffer itself.
 
 (defun notmuch-pick-clean-address (address)
   "Try to clean a single email ADDRESS for display. Return
@@ -707,6 +759,7 @@ message together with all its descendents."
        (push "├" tree-status)))
 
       (push (concat (if replies "┬" "─") "►") tree-status)
+      (plist-put msg :first (and first (eq 0 depth)))
       (notmuch-pick-goto-and-insert-msg (plist-put msg :tree-status tree-status))
       (pop tree-status)
       (pop tree-status)
@@ -800,12 +853,15 @@ Complete list of currently available key bindings:
        (notmuch-sexp-parse-partial-list 'notmuch-pick-insert-forest-thread
                                         results-buf)))))
 
-(defun notmuch-pick-worker (basic-query &optional query-context target buffer open-target)
+(defun notmuch-pick-worker (basic-query &optional query-context target open-target)
+  "Insert the actual pick search in the current buffer.
+
+This is is a helper function for notmuch-pick. The arguments are
+the same as for the function notmuch-pick."
   (interactive)
   (notmuch-pick-mode)
   (setq notmuch-pick-basic-query basic-query)
   (setq notmuch-pick-query-context query-context)
-  (setq notmuch-pick-buffer-name (buffer-name buffer))
   (setq notmuch-pick-target-msg target)
   (setq notmuch-pick-open-target open-target)
 
@@ -817,26 +873,17 @@ Complete list of currently available key bindings:
         (message-arg "--entire-thread"))
     (if (equal (car (process-lines notmuch-command "count" search-args)) "0")
        (setq search-args basic-query))
-    (if notmuch-pick-asynchronous-parser
-       (let ((proc (notmuch-start-notmuch
-                    "notmuch-pick" buffer #'notmuch-pick-process-sentinel
-                    "show" "--body=false" "--format=sexp"
-                    message-arg search-args))
-             ;; Use a scratch buffer to accumulate partial output.
-              ;; This buffer will be killed by the sentinel, which
-              ;; should be called no matter how the process dies.
-              (parse-buf (generate-new-buffer " *notmuch pick parse*")))
-          (process-put proc 'parse-buf parse-buf)
-         (set-process-filter proc 'notmuch-pick-process-filter)
-         (set-process-query-on-exit-flag proc nil))
-      (progn
-       (notmuch-pick-insert-forest
-        (notmuch-query-get-threads
-         (list "--body=false" message-arg search-args)))
-       (save-excursion
-         (goto-char (point-max))
-         (insert "End of search results.\n"))))))
-
+    (let ((proc (notmuch-start-notmuch
+                "notmuch-pick" (current-buffer) #'notmuch-pick-process-sentinel
+                "show" "--body=false" "--format=sexp"
+                message-arg search-args))
+         ;; Use a scratch buffer to accumulate partial output.
+         ;; This buffer will be killed by the sentinel, which
+         ;; should be called no matter how the process dies.
+         (parse-buf (generate-new-buffer " *notmuch pick parse*")))
+      (process-put proc 'parse-buf parse-buf)
+      (set-process-filter proc 'notmuch-pick-process-filter)
+      (set-process-query-on-exit-flag proc nil))))
 
 (defun notmuch-pick (&optional query query-context target buffer-name open-target)
   "Run notmuch pick with the given `query' and display the results.
@@ -860,13 +907,13 @@ The arguments are:
                                        (concat "*notmuch-pick-" query "*")))))
        (inhibit-read-only t))
 
-    (switch-to-buffer buffer)
-    ;; Don't track undo information for this buffer
-    (set 'buffer-undo-list t)
+    (switch-to-buffer buffer))
+  ;; Don't track undo information for this buffer
+  (set 'buffer-undo-list t)
 
-    (notmuch-pick-worker query query-context target buffer open-target)
+  (notmuch-pick-worker query query-context target open-target)
 
-    (setq truncate-lines t)))
+  (setq truncate-lines t))
 
 
 ;; Set up key bindings from the rest of notmuch.