]> git.notmuchmail.org Git - notmuch/blobdiff - emacs/notmuch-show.el
emacs: Use interactive specifications for tag changes in show
[notmuch] / emacs / notmuch-show.el
index 2896aae855ca78e076d2a4b098ddd108078c4203..81ee87a8b8e8cd8b27d0eba312c8b5abe55065ba 100644 (file)
@@ -470,7 +470,7 @@ message at DEPTH in the current thread."
             (new-start (button-start button))
             (button-label (button-get button :base-label))
             (old-point (point))
-            (properties (text-properties-at (point)))
+            (properties (text-properties-at (button-start button)))
             (inhibit-read-only t))
        ;; Toggle the button itself.
        (button-put button :notmuch-part-hidden (not show))
@@ -588,6 +588,10 @@ message at DEPTH in the current thread."
 
     ;; Render the primary part.
     (notmuch-show-insert-bodypart msg (car inner-parts) depth)
+    ;; Add hidden buttons for the rest
+    (mapc (lambda (inner-part)
+           (notmuch-show-insert-bodypart msg inner-part depth t))
+         (cdr inner-parts))
 
     (when notmuch-show-indent-multipart
       (indent-rigidly start (point) 1)))
@@ -844,7 +848,11 @@ message at DEPTH in the current thread."
 (defun notmuch-show-insert-bodypart (msg part depth &optional hide)
   "Insert the body part PART at depth DEPTH in the current thread.
 
-If HIDE is non-nil then initially hide this part."
+HIDE determines whether to show or hide the part and the button
+as follows: If HIDE is nil, show the part and the button. If HIDE
+is t, hide the part initially and show the button. If HIDE is
+'no-buttons, show the part but do not add any buttons (this is
+useful for quoting in replies)."
 
   (let* ((content-type (downcase (plist-get part :content-type)))
         (mime-type (or (and (string= content-type "application/octet-stream")
@@ -854,15 +862,19 @@ If HIDE is non-nil then initially hide this part."
                        content-type))
         (nth (plist-get part :id))
         (beg (point))
-        ;; We omit the part button for the first (or only) part if this is text/plain.
-        (button (unless (and (string= mime-type "text/plain") (<= nth 1))
+        ;; Hide the part initially if HIDE is t.
+        (show-part (not (equal hide t)))
+        ;; We omit the part button for the first (or only) part if
+        ;; this is text/plain, or HIDE is 'no-buttons.
+        (button (unless (or (equal hide 'no-buttons)
+                            (and (string= mime-type "text/plain") (<= nth 1)))
                   (notmuch-show-insert-part-header nth mime-type content-type (plist-get part :filename))))
         (content-beg (point)))
 
     ;; Store the computed mime-type for later use (e.g. by attachment handlers).
     (plist-put part :computed-type mime-type)
 
-    (if (not hide)
+    (if show-part
         (notmuch-show-insert-bodypart-internal msg part mime-type nth depth button)
       (button-put button :notmuch-lazy-part
                   (list msg part mime-type nth depth button)))
@@ -875,7 +887,7 @@ If HIDE is non-nil then initially hide this part."
       (insert "\n"))
     ;; We do not create the overlay for hidden (lazy) parts until
     ;; they are inserted.
-    (if (not hide)
+    (if show-part
        (notmuch-show-create-part-overlays button content-beg (point))
       (save-excursion
        (notmuch-show-toggle-part-invisibility button)))
@@ -1068,15 +1080,17 @@ buttons for a corresponding notmuch search."
        (make-text-button (first link) (second link)
                          :type 'notmuch-button-type
                          'action `(lambda (arg)
-                                    (notmuch-show ,(third link)))
+                                    (notmuch-show ,(third link) current-prefix-arg))
                          'follow-link t
                          'help-echo "Mouse-1, RET: search for this message"
                          'face goto-address-mail-face)))))
 
 ;;;###autoload
-(defun notmuch-show (thread-id &optional parent-buffer query-context buffer-name)
+(defun notmuch-show (thread-id &optional elide-toggle parent-buffer query-context buffer-name)
   "Run \"notmuch show\" with the given thread ID and display results.
 
+ELIDE-TOGGLE, if non-nil, inverts the default elide behavior.
+
 The optional PARENT-BUFFER is the notmuch-search buffer from
 which this notmuch-show command was executed, (so that the
 next thread from that buffer can be show when done with this
@@ -1090,7 +1104,7 @@ The optional BUFFER-NAME provides the name of the buffer in
 which the message thread is shown. If it is nil (which occurs
 when the command is called interactively) the argument to the
 function is used."
-  (interactive "sNotmuch show: ")
+  (interactive "sNotmuch show: \nP")
   (let ((buffer-name (generate-new-buffer-name
                      (or buffer-name
                          (concat "*notmuch-" thread-id "*")))))
@@ -1100,9 +1114,9 @@ function is used."
     (setq notmuch-show-process-crypto notmuch-crypto-process-mime)
     ;; Set the default value for
     ;; `notmuch-show-elide-non-matching-messages' in this buffer. If
-    ;; there is a prefix argument, invert the default.
+    ;; elide-toggle is set, invert the default.
     (setq notmuch-show-elide-non-matching-messages notmuch-show-only-matching-messages)
-    (if current-prefix-arg
+    (if elide-toggle
        (setq notmuch-show-elide-non-matching-messages (not notmuch-show-elide-non-matching-messages)))
 
     (setq notmuch-show-thread-id thread-id
@@ -1231,14 +1245,11 @@ reset based on the original query."
 
 (defvar notmuch-show-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 (kbd "<C-tab>") 'widget-backward)
        (define-key map (kbd "M-TAB") 'notmuch-show-previous-button)
        (define-key map (kbd "<backtab>") 'notmuch-show-previous-button)
        (define-key map (kbd "TAB") 'notmuch-show-next-button)
-       (define-key map "s" 'notmuch-search)
-       (define-key map "m" 'notmuch-mua-new-mail)
        (define-key map "f" 'notmuch-show-forward-message)
        (define-key map "r" 'notmuch-show-reply-sender)
        (define-key map "R" 'notmuch-show-reply)
@@ -1246,7 +1257,6 @@ reset based on the original query."
        (define-key map "w" 'notmuch-show-save-attachments)
        (define-key map "V" 'notmuch-show-view-raw-message)
        (define-key map "c" 'notmuch-show-stash-map)
-       (define-key map "=" 'notmuch-show-refresh-view)
        (define-key map "h" 'notmuch-show-toggle-visibility-headers)
        (define-key map "*" 'notmuch-show-tag-all)
        (define-key map "-" 'notmuch-show-remove-tag)
@@ -1305,6 +1315,7 @@ All currently available key bindings:
 \\{notmuch-show-mode-map}"
   (interactive)
   (kill-all-local-variables)
+  (setq notmuch-buffer-refresh-function #'notmuch-show-refresh-view)
   (use-local-map notmuch-show-mode-map)
   (setq major-mode 'notmuch-show-mode
        mode-name "notmuch-show")
@@ -1479,6 +1490,8 @@ current thread."
   "Are the headers of the current message visible?"
   (notmuch-show-get-prop :headers-visible))
 
+(put 'notmuch-show-mark-read 'notmuch-prefix-doc
+     "Mark the current message as unread.")
 (defun notmuch-show-mark-read (&optional unread)
   "Mark the current message as read.
 
@@ -1566,7 +1579,7 @@ shown."
       (notmuch-show-archive-thread-then-next)))
 
 (defun notmuch-show-rewind ()
-  "Backup through the thread, (reverse scrolling compared to \\[notmuch-show-advance-and-archive]).
+  "Backup through the thread (reverse scrolling compared to \\[notmuch-show-advance-and-archive]).
 
 Specifically, if the beginning of the previous email is fewer
 than `window-height' lines from the current point, move to it
@@ -1600,16 +1613,20 @@ any effects from previous calls to
       ;; Move to the previous message.
       (notmuch-show-previous-message)))))
 
+(put 'notmuch-show-reply 'notmuch-prefix-doc "... and prompt for sender")
 (defun notmuch-show-reply (&optional prompt-for-sender)
   "Reply to the sender and all recipients of the current message."
   (interactive "P")
   (notmuch-mua-new-reply (notmuch-show-get-message-id) prompt-for-sender t))
 
+(put 'notmuch-show-reply-sender 'notmuch-prefix-doc "... and prompt for sender")
 (defun notmuch-show-reply-sender (&optional prompt-for-sender)
   "Reply to the sender of the current message."
   (interactive "P")
   (notmuch-mua-new-reply (notmuch-show-get-message-id) prompt-for-sender nil))
 
+(put 'notmuch-show-forward-message 'notmuch-prefix-doc
+     "... and prompt for sender")
 (defun notmuch-show-forward-message (&optional prompt-for-sender)
   "Forward the current message."
   (interactive "P")
@@ -1713,16 +1730,21 @@ to show, nil otherwise."
     (set-buffer-modified-p nil)
     (view-buffer buf 'kill-buffer-if-not-modified)))
 
+(put 'notmuch-show-pipe-message 'notmuch-doc
+     "Pipe the contents of the current message to a command.")
+(put 'notmuch-show-pipe-message 'notmuch-prefix-doc
+     "Pipe the thread as an mbox to a command.")
 (defun notmuch-show-pipe-message (entire-thread command)
-  "Pipe the contents of the current message (or thread) to the given command.
+  "Pipe the contents of the current message (or thread) to 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.
+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."
+If ENTIRE-THREAD is non-nil (or when invoked with a prefix
+argument), COMMAND will receive all open messages in the current
+thread (formatted as an mbox) rather than only the current
+message."
   (interactive (let ((query-string (if current-prefix-arg
                                       "Pipe all open messages to command: "
                                     "Pipe message to command: ")))
@@ -1760,23 +1782,28 @@ TAG-CHANGES is a list of tag operations for `notmuch-tag'."
       (notmuch-tag (notmuch-show-get-message-id) tag-changes)
       (notmuch-show-set-tags new-tags))))
 
-(defun notmuch-show-tag (&optional tag-changes)
+(defun notmuch-show-tag (tag-changes)
   "Change tags for the current message.
 
 See `notmuch-tag' for information on the format of TAG-CHANGES."
-  (interactive)
-  (let* ((tag-changes (notmuch-tag (notmuch-show-get-message-id) tag-changes))
-        (current-tags (notmuch-show-get-tags))
+  (interactive (list (notmuch-read-tag-changes (notmuch-show-get-tags)
+                                              "Tag message")))
+  (notmuch-tag (notmuch-show-get-message-id) tag-changes)
+  (let* ((current-tags (notmuch-show-get-tags))
         (new-tags (notmuch-update-tags current-tags tag-changes)))
     (unless (equal current-tags new-tags)
       (notmuch-show-set-tags new-tags))))
 
-(defun notmuch-show-tag-all (&optional tag-changes)
+(defun notmuch-show-tag-all (tag-changes)
   "Change tags for all messages in the current show buffer.
 
 See `notmuch-tag' for information on the format of TAG-CHANGES."
-  (interactive)
-  (setq tag-changes (notmuch-tag (notmuch-show-get-messages-ids-search) tag-changes))
+  (interactive
+   (list (let (tags)
+          (notmuch-show-mapc
+           (lambda () (setq tags (append (notmuch-show-get-tags) tags))))
+          (notmuch-read-tag-changes tags "Tag thread"))))
+  (notmuch-tag (notmuch-show-get-messages-ids-search) tag-changes)
   (notmuch-show-mapc
    (lambda ()
      (let* ((current-tags (notmuch-show-get-tags))
@@ -1784,15 +1811,21 @@ See `notmuch-tag' for information on the format of TAG-CHANGES."
        (unless (equal current-tags new-tags)
         (notmuch-show-set-tags new-tags))))))
 
-(defun notmuch-show-add-tag ()
-  "Same as `notmuch-show-tag' but sets initial input to '+'."
-  (interactive)
-  (notmuch-show-tag "+"))
+(defun notmuch-show-add-tag (tag-changes)
+  "Change tags for the current message (defaulting to add).
 
-(defun notmuch-show-remove-tag ()
-  "Same as `notmuch-show-tag' but sets initial input to '-'."
-  (interactive)
-  (notmuch-show-tag "-"))
+Same as `notmuch-show-tag' but sets initial input to '+'."
+  (interactive
+   (list (notmuch-read-tag-changes (notmuch-show-get-tags) "Tag message" "+")))
+  (notmuch-show-tag tag-changes))
+
+(defun notmuch-show-remove-tag (tag-changes)
+  "Change tags for the current message (defaulting to remove).
+
+Same as `notmuch-show-tag' but sets initial input to '-'."
+  (interactive
+   (list (notmuch-read-tag-changes (notmuch-show-get-tags) "Tag message" "-")))
+  (notmuch-show-tag tag-changes))
 
 (defun notmuch-show-toggle-visibility-headers ()
   "Toggle the visibility of the current message headers."
@@ -1812,8 +1845,11 @@ See `notmuch-tag' for information on the format of TAG-CHANGES."
      (not (plist-get props :message-visible))))
   (force-window-update))
 
+(put 'notmuch-show-open-or-close-all 'notmuch-doc "Show all messages.")
+(put 'notmuch-show-open-or-close-all 'notmuch-prefix-doc "Hide all messages.")
 (defun notmuch-show-open-or-close-all ()
   "Set the visibility all of the messages in the current thread.
+
 By default make all of the messages visible. With a prefix
 argument, hide all of the messages."
   (interactive)
@@ -1862,6 +1898,8 @@ search results instead."
   (interactive)
   (notmuch-show-next-thread t t))
 
+(put 'notmuch-show-archive-thread 'notmuch-prefix-doc
+     "Un-archive each message in thread.")
 (defun notmuch-show-archive-thread (&optional unarchive)
   "Archive each message in thread.
 
@@ -1891,6 +1929,8 @@ buffer."
   (notmuch-show-archive-thread)
   (notmuch-show-next-thread))
 
+(put 'notmuch-show-archive-message 'notmuch-prefix-doc
+     "Un-archive the current message.")
 (defun notmuch-show-archive-message (&optional unarchive)
   "Archive the current message.
 
@@ -1942,6 +1982,8 @@ thread from search."
   (interactive)
   (notmuch-common-do-stash (notmuch-show-get-from)))
 
+(put 'notmuch-show-stash-message-id 'notmuch-prefix-doc
+     "Copy thread: query matching current thread to kill-ring.")
 (defun notmuch-show-stash-message-id (&optional stash-thread-id)
   "Copy id: query matching the current message to kill-ring.