X-Git-Url: https://git.notmuchmail.org/git?p=notmuch;a=blobdiff_plain;f=contrib%2Fnotmuch-pick%2Fnotmuch-pick.el;h=37dc161e544ab5fb37cfd114d10a5d961111c499;hp=c436bf1cac940094371d471cd63d2c443aae91c8;hb=e3c2be3e255f2845f6c6b45da96064e2bba681da;hpb=bb03a26c25fc4a39504d5cb4f647376d2d5114e8

diff --git a/contrib/notmuch-pick/notmuch-pick.el b/contrib/notmuch-pick/notmuch-pick.el
index c436bf1c..37dc161e 100644
--- a/contrib/notmuch-pick/notmuch-pick.el
+++ b/contrib/notmuch-pick/notmuch-pick.el
@@ -187,25 +187,73 @@ if the user has loaded a different buffer in that window.")
 (make-variable-buffer-local 'notmuch-pick-message-buffer)
 (put 'notmuch-pick-message-buffer 'permanent-local t)
 
+(defun notmuch-pick-to-message-pane (func)
+  "Execute FUNC in message pane.
+
+This function returns a function (so can be used as a keybinding)
+which executes function FUNC in the message pane if it is
+open (if the message pane is closed it does nothing)."
+  `(lambda ()
+      ,(concat "(In message pane) " (documentation func t))
+     (interactive)
+     (when (window-live-p notmuch-pick-message-window)
+       (with-selected-window notmuch-pick-message-window
+	 (call-interactively #',func)))))
+
+(defun notmuch-pick-button-activate (&optional button)
+  "Activate BUTTON or button at point
+
+This function does not give an error if there is no button."
+  (interactive)
+  (let ((button (or button (button-at (point)))))
+    (when button (button-activate button))))
+
+(defun notmuch-pick-close-message-pane-and (func)
+  "Close message pane and execute FUNC.
+
+This function returns a function (so can be used as a keybinding)
+which closes the message pane if open and then executes function
+FUNC."
+  `(lambda ()
+      ,(concat "(Close message pane and) " (documentation func t))
+     (interactive)
+     (notmuch-pick-close-message-window)
+     (call-interactively #',func)))
+
 (defvar notmuch-pick-mode-map
   (let ((map (make-sparse-keymap)))
     (define-key map [mouse-1] 'notmuch-pick-show-message)
+    ;; these use notmuch-show functions directly
+    (define-key map "|" 'notmuch-show-pipe-message)
+    (define-key map "w" 'notmuch-show-save-attachments)
+    (define-key map "v" 'notmuch-show-view-all-mime-parts)
+    (define-key map "c" 'notmuch-show-stash-map)
+
+    ;; these apply to the message pane
+    (define-key map (kbd "M-TAB") (notmuch-pick-to-message-pane #'notmuch-show-previous-button))
+    (define-key map (kbd "<backtab>")  (notmuch-pick-to-message-pane #'notmuch-show-previous-button))
+    (define-key map (kbd "TAB") (notmuch-pick-to-message-pane #'notmuch-show-next-button))
+    (define-key map "e" (notmuch-pick-to-message-pane #'notmuch-pick-button-activate))
+
+    ;; bindings from show (or elsewhere) but we close the message pane first.
+    (define-key map "m" (notmuch-pick-close-message-pane-and #'notmuch-mua-new-mail))
+    (define-key map "f" (notmuch-pick-close-message-pane-and #'notmuch-show-forward-message))
+    (define-key map "r" (notmuch-pick-close-message-pane-and #'notmuch-show-reply-sender))
+    (define-key map "R" (notmuch-pick-close-message-pane-and #'notmuch-show-reply))
+    (define-key map "V" (notmuch-pick-close-message-pane-and #'notmuch-show-view-raw-message))
+    (define-key map "?" (notmuch-pick-close-message-pane-and #'notmuch-help))
+
+    ;; The main pick bindings
     (define-key map "q" 'notmuch-pick-quit)
     (define-key map "x" 'notmuch-pick-quit)
-    (define-key map "?" 'notmuch-help)
     (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)
     (define-key map "z" 'notmuch-pick-to-pick)
-    (define-key map "m" 'notmuch-pick-new-mail)
-    (define-key map "f" 'notmuch-pick-forward-message)
-    (define-key map "r" 'notmuch-pick-reply-sender)
-    (define-key map "R" 'notmuch-pick-reply)
     (define-key map "n" 'notmuch-pick-next-matching-message)
     (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 "|" 'notmuch-pick-pipe-message)
     (define-key map "-" 'notmuch-pick-remove-tag)
     (define-key map "+" 'notmuch-pick-add-tag)
     (define-key map " " 'notmuch-pick-scroll-or-next)
@@ -238,6 +286,22 @@ Some useful entries are:
     (beginning-of-line)
     (get-text-property (point) :notmuch-message-properties)))
 
+;; XXX This should really be a lib function but we are trying to
+;; reduce impact on the code base.
+(defun notmuch-show-get-prop (prop &optional props)
+  "This is a pick overridden version of notmuch-show-get-prop
+
+It gets property PROP from PROPS or, if PROPS is nil, the current
+message in either pick or show. This means that several functions
+in notmuch-show now work unchanged in pick as they just need the
+correct message properties."
+  (let ((props (or props
+		   (cond ((eq major-mode 'notmuch-show-mode)
+			  (notmuch-show-get-message-properties))
+			 ((eq major-mode 'notmuch-pick-mode)
+			  (notmuch-pick-get-message-properties))))))
+    (plist-get props prop)))
+
 (defun notmuch-pick-set-message-properties (props)
   (save-excursion
     (beginning-of-line)
@@ -276,6 +340,11 @@ Some useful entries are:
   (notmuch-pick-get-prop :match))
 
 (defun notmuch-pick-refresh-result ()
+  "Redisplay the current message line.
+
+This redisplays the current line based on the messages
+properties (as they are now). This is used when tags are
+updated."
   (let ((init-point (point))
 	(end (line-end-position))
 	(msg (notmuch-pick-get-message-properties))
@@ -379,6 +448,7 @@ Does NOT change the database."
 		t))
 
 (defun notmuch-pick-message-window-kill-hook ()
+  "Close the message pane when exiting the show buffer."
   (let ((buffer (current-buffer)))
     (when (and (window-live-p notmuch-pick-message-window)
 	       (eq (window-buffer notmuch-pick-message-window) buffer))
@@ -529,69 +599,6 @@ message will be \"unarchived\", i.e. the tag changes in
 			 target
 			 (get-buffer buffer-name))))
 
-(defmacro with-current-notmuch-pick-message (&rest body)
-  "Evaluate body with current buffer set to the text of current message"
-  `(save-excursion
-     (let ((id (notmuch-pick-get-message-id)))
-       (let ((buf (generate-new-buffer (concat "*notmuch-msg-" id "*"))))
-         (with-current-buffer buf
-	    (call-process notmuch-command nil t nil "show" "--format=raw" id)
-           ,@body)
-	 (kill-buffer buf)))))
-
-(defun notmuch-pick-new-mail (&optional prompt-for-sender)
-  "Compose new mail."
-  (interactive "P")
-  (notmuch-pick-close-message-window)
-  (notmuch-mua-new-mail prompt-for-sender ))
-
-(defun notmuch-pick-forward-message (&optional prompt-for-sender)
-  "Forward the current message."
-  (interactive "P")
-  (notmuch-pick-close-message-window)
-  (with-current-notmuch-pick-message
-   (notmuch-mua-new-forward-message prompt-for-sender)))
-
-(defun notmuch-pick-reply (&optional prompt-for-sender)
-  "Reply to the sender and all recipients of the current message."
-  (interactive "P")
-  (notmuch-pick-close-message-window)
-  (notmuch-mua-new-reply (notmuch-pick-get-message-id) prompt-for-sender t))
-
-(defun notmuch-pick-reply-sender (&optional prompt-for-sender)
-  "Reply to the sender of the current message."
-  (interactive "P")
-  (notmuch-pick-close-message-window)
-  (notmuch-mua-new-reply (notmuch-pick-get-message-id) prompt-for-sender nil))
-
-;; Shamelessly stolen from notmuch-show.el: maybe should be unified.
-(defun notmuch-pick-pipe-message (command)
-  "Pipe the contents of the current message to the given command.
-
-The given command will be executed with the raw contents of the
-current email message as stdin. Anything printed by the command
-to stdout or stderr will appear in the *notmuch-pipe* buffer.
-
-When invoked with a prefix argument, the command will receive all
-open messages in the current thread (formatted as an mbox) rather
-than only the current message."
-  (interactive "sPipe message to command: ")
-  (let ((shell-command
-	 (concat notmuch-command " show --format=raw "
-		 (shell-quote-argument (notmuch-pick-get-message-id)) " | " command))
-	 (buf (get-buffer-create (concat "*notmuch-pipe*"))))
-    (with-current-buffer buf
-      (setq buffer-read-only nil)
-      (erase-buffer)
-      (let ((exit-code (call-process-shell-command shell-command nil buf)))
-	(goto-char (point-max))
-	(set-buffer-modified-p nil)
-	(setq buffer-read-only t)
-	(unless (zerop exit-code)
-	  (switch-to-buffer-other-window buf)
-	  (message (format "Command '%s' exited abnormally with code %d"
-			   shell-command exit-code)))))))
-
 (defun notmuch-pick-clean-address (address)
   "Try to clean a single email ADDRESS for display. Return
 AUTHOR_NAME if present, otherwise return AUTHOR_EMAIL. Return
@@ -677,7 +684,10 @@ unchanged ADDRESS if parsing fails."
 	(notmuch-pick-show-message)))))
 
 (defun notmuch-pick-insert-tree (tree depth tree-status first last)
-  "Insert the message tree TREE at depth DEPTH in the current thread."
+  "Insert the message tree TREE at depth DEPTH in the current thread.
+
+A message tree is another name for a single sub-thread: i.e., a
+message together with all its descendents."
   (let ((msg (car tree))
 	(replies (cadr tree)))
 
@@ -708,7 +718,7 @@ unchanged ADDRESS if parsing fails."
     (notmuch-pick-insert-thread replies (1+ depth) tree-status)))
 
 (defun notmuch-pick-insert-thread (thread depth tree-status)
-  "Insert the thread THREAD at depth DEPTH >= 1 in the current forest."
+  "Insert the collection of sibling sub-threads THREAD at depth DEPTH in the current forest."
   (let ((n (length thread)))
     (loop for tree in thread
 	  for count from 1 to n
@@ -716,12 +726,17 @@ unchanged ADDRESS if parsing fails."
 	  do (notmuch-pick-insert-tree tree depth tree-status (eq count 1) (eq count n)))))
 
 (defun notmuch-pick-insert-forest-thread (forest-thread)
+  "Insert a single complete thread."
   (let (tree-status)
     ;; Reset at the start of each main thread.
     (setq notmuch-pick-previous-subject nil)
     (notmuch-pick-insert-thread forest-thread 0 tree-status)))
 
 (defun notmuch-pick-insert-forest (forest)
+  "Insert a forest of threads.
+
+This function inserts a collection of several complete threads as
+passed to it by notmuch-pick-process-filter."
   (mapc 'notmuch-pick-insert-forest-thread forest))
 
 (defun notmuch-pick-mode ()
@@ -803,16 +818,15 @@ Complete list of currently available key bindings:
     (if (equal (car (process-lines notmuch-command "count" search-args)) "0")
 	(setq search-args basic-query))
     (if notmuch-pick-asynchronous-parser
-	(let ((proc (start-process
-		     "notmuch-pick" buffer
-		     notmuch-command "show" "--body=false" "--format=sexp"
+	(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-sentinel proc 'notmuch-pick-process-sentinel)
 	  (set-process-filter proc 'notmuch-pick-process-filter)
 	  (set-process-query-on-exit-flag proc nil))
       (progn