]> git.notmuchmail.org Git - notmuch/blobdiff - emacs/notmuch-show.el
emacs: Rework crypto switch toggle.
[notmuch] / emacs / notmuch-show.el
index 48a2a60fb071286edbe228ecd9e98d127cf7ad63..e209122932de183b724e417cc37ba3f2cabf05c0 100644 (file)
@@ -126,6 +126,22 @@ indentation."
                 (const :tag "View interactively"
                        notmuch-show-interactively-view-part)))
 
+(defvar notmuch-show-thread-id nil)
+(make-variable-buffer-local 'notmuch-show-thread-id)
+(put 'notmuch-show-thread-id 'permanent-local t)
+
+(defvar notmuch-show-parent-buffer nil)
+(make-variable-buffer-local 'notmuch-show-parent-buffer)
+(put 'notmuch-show-parent-buffer 'permanent-local t)
+
+(defvar notmuch-show-query-context nil)
+(make-variable-buffer-local 'notmuch-show-query-context)
+(put 'notmuch-show-query-context 'permanent-local t)
+
+(defvar notmuch-show-process-crypto nil)
+(make-variable-buffer-local 'notmuch-show-process-crypto)
+(put 'notmuch-show-process-crypto 'permanent-local t)
+
 (defmacro with-current-notmuch-show-message (&rest body)
   "Evaluate body with current buffer set to the text of current message"
   `(save-excursion
@@ -611,7 +627,7 @@ current buffer, if possible."
               (sigstatus (car (plist-get part :sigstatus))))
          (notmuch-crypto-insert-sigstatus-button sigstatus from))
       ;; if we're not adding sigstatus, tell the user how they can get it
-      (button-put button 'help-echo "Set notmuch-crypto-process-mime to process cryptographic mime parts.")))
+      (button-put button 'help-echo "Set notmuch-crypto-process-mime to process cryptographic MIME parts.")))
 
   (let ((inner-parts (plist-get part :content))
        (start (point)))
@@ -637,7 +653,7 @@ current buffer, if possible."
                     (sigstatus (car (plist-get part :sigstatus))))
                (notmuch-crypto-insert-sigstatus-button sigstatus from))))
       ;; if we're not adding encstatus, tell the user how they can get it
-      (button-put button 'help-echo "Set notmuch-crypto-process-mime to process cryptographic mime parts.")))
+      (button-put button 'help-echo "Set notmuch-crypto-process-mime to process cryptographic MIME parts.")))
 
   (let ((inner-parts (plist-get part :content))
        (start (point)))
@@ -764,8 +780,6 @@ current buffer, if possible."
 
 ;; Helper for parts which are generally not included in the default
 ;; JSON output.
-;; Uses the buffer-local variable notmuch-show-process-crypto to
-;; determine if parts should be decrypted first.
 (defun notmuch-show-get-bodypart-internal (message-id part-number)
   (let ((args '("show" "--format=raw"))
        (part-arg (format "--part=%s" part-number)))
@@ -919,6 +933,15 @@ current buffer, if possible."
     ;; criteria.
     (notmuch-show-message-visible msg (plist-get msg :match))))
 
+(defun notmuch-show-toggle-process-crypto ()
+  "Toggle the processing of cryptographic MIME parts."
+  (interactive)
+  (setq notmuch-show-process-crypto (not notmuch-show-process-crypto))
+  (message (if notmuch-show-process-crypto
+              "Processing cryptographic MIME parts."
+            "Not processing cryptographic MIME parts."))
+  (notmuch-show-refresh-view))
+
 (defun notmuch-show-insert-tree (tree depth)
   "Insert the message tree TREE at depth DEPTH in the current thread."
   (let ((msg (car tree))
@@ -934,15 +957,6 @@ current buffer, if possible."
   "Insert the forest of threads FOREST."
   (mapc (lambda (thread) (notmuch-show-insert-thread thread 0)) forest))
 
-(defvar notmuch-show-thread-id nil)
-(make-variable-buffer-local 'notmuch-show-thread-id)
-(defvar notmuch-show-parent-buffer nil)
-(make-variable-buffer-local 'notmuch-show-parent-buffer)
-(defvar notmuch-show-query-context nil)
-(make-variable-buffer-local 'notmuch-show-query-context)
-(defvar notmuch-show-buffer-name nil)
-(make-variable-buffer-local 'notmuch-show-buffer-name)
-
 (defun notmuch-show-buttonise-links (start end)
   "Buttonise URLs and mail addresses between START and END.
 
@@ -962,7 +976,7 @@ a corresponding notmuch search."
                        'face goto-address-mail-face))))
 
 ;;;###autoload
-(defun notmuch-show (thread-id &optional parent-buffer query-context buffer-name crypto-switch)
+(defun notmuch-show (thread-id &optional parent-buffer query-context buffer-name)
   "Run \"notmuch show\" with the given thread ID and display results.
 
 The optional PARENT-BUFFER is the notmuch-search buffer from
@@ -977,46 +991,41 @@ non-nil.
 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.
-
-The optional CRYPTO-SWITCH toggles the value of the
-notmuch-crypto-process-mime customization variable for this show
-buffer."
+function is used."
   (interactive "sNotmuch show: ")
-  (let* ((process-crypto (if crypto-switch
-                            (not notmuch-crypto-process-mime)
-                          notmuch-crypto-process-mime)))
-    (notmuch-show-worker thread-id parent-buffer query-context buffer-name process-crypto)))
-
-(defun notmuch-show-worker (thread-id parent-buffer query-context buffer-name process-crypto)
-  (let* ((buffer-name (generate-new-buffer-name
-                      (or buffer-name
-                          (concat "*notmuch-" thread-id "*"))))
-        (buffer (get-buffer-create buffer-name))
-        (inhibit-read-only t))
-    (switch-to-buffer buffer)
+  (let ((buffer-name (generate-new-buffer-name
+                     (or buffer-name
+                         (concat "*notmuch-" thread-id "*")))))
+    (switch-to-buffer (get-buffer-create buffer-name))
+    ;; Set the default value for `notmuch-show-process-crypto' in this
+    ;; buffer.
+    (setq notmuch-show-process-crypto notmuch-crypto-process-mime)
+
+    (setq notmuch-show-thread-id thread-id
+         notmuch-show-parent-buffer parent-buffer
+         notmuch-show-query-context query-context)
+    (notmuch-show-worker)))
+
+(defun notmuch-show-worker ()
+  (let ((inhibit-read-only t))
+
     (notmuch-show-mode)
     ;; Don't track undo information for this buffer
     (set 'buffer-undo-list t)
 
-    (setq notmuch-show-thread-id thread-id)
-    (setq notmuch-show-parent-buffer parent-buffer)
-    (setq notmuch-show-query-context query-context)
-    (setq notmuch-show-buffer-name buffer-name)
-    (setq notmuch-show-process-crypto process-crypto)
-
     (erase-buffer)
     (goto-char (point-min))
     (save-excursion
-      (let* ((basic-args (list thread-id))
-            (args (if query-context
-                      (append (list "\'") basic-args (list "and (" query-context ")\'"))
+      (let* ((basic-args (list notmuch-show-thread-id))
+            (args (if notmuch-show-query-context
+                      (append (list "\'") basic-args
+                              (list "and (" notmuch-show-query-context ")\'"))
                     (append (list "\'") basic-args (list "\'")))))
        (notmuch-show-insert-forest (notmuch-query-get-threads args))
        ;; If the query context reduced the results to nothing, run
        ;; the basic query.
        (when (and (eq (buffer-size) 0)
-                  query-context)
+                  notmuch-show-query-context)
          (notmuch-show-insert-forest
           (notmuch-query-get-threads basic-args))))
 
@@ -1033,21 +1042,14 @@ buffer."
 
     (notmuch-show-mark-read)))
 
-(defun notmuch-show-refresh-view (&optional crypto-switch)
-  "Refresh the current view (with crypto switch if prefix given).
+(defun notmuch-show-refresh-view ()
+  "Refresh the current view.
 
-Kills the current buffer and reruns notmuch show with the same
-thread id.  If a prefix is given, crypto processing is toggled."
-  (interactive "P")
-  (let ((thread-id notmuch-show-thread-id)
-       (parent-buffer notmuch-show-parent-buffer)
-       (query-context notmuch-show-query-context)
-       (buffer-name notmuch-show-buffer-name)
-       (process-crypto (if crypto-switch
-                           (not notmuch-show-process-crypto)
-                         notmuch-show-process-crypto)))
-    (notmuch-kill-this-buffer)
-    (notmuch-show-worker thread-id parent-buffer query-context buffer-name process-crypto)))
+Refreshes the current view, observing changes in cryptographic preferences."
+  (interactive)
+  (let ((inhibit-read-only t))
+    (erase-buffer))
+  (notmuch-show-worker))
 
 (defvar notmuch-show-stash-map
   (let ((map (make-sparse-keymap)))
@@ -1084,11 +1086,13 @@ thread id.  If a prefix is given, crypto processing is toggled."
        (define-key map "c" 'notmuch-show-stash-map)
        (define-key map "=" 'notmuch-show-refresh-view)
        (define-key map "h" 'notmuch-show-toggle-headers)
+       (define-key map "*" 'notmuch-show-tag-all)
        (define-key map "-" 'notmuch-show-remove-tag)
        (define-key map "+" 'notmuch-show-add-tag)
-       (define-key map "x" 'notmuch-show-archive-thread-then-exit)
-       (define-key map "a" 'notmuch-show-archive-message-then-next)
+       (define-key map "X" 'notmuch-show-archive-thread-then-exit)
+       (define-key map "x" 'notmuch-show-archive-message-then-next-or-exit)
        (define-key map "A" 'notmuch-show-archive-thread-then-next)
+       (define-key map "a" 'notmuch-show-archive-message-then-next-or-next-thread)
        (define-key map "N" 'notmuch-show-next-message)
        (define-key map "P" 'notmuch-show-previous-message)
        (define-key map "n" 'notmuch-show-next-open-message)
@@ -1098,6 +1102,7 @@ thread id.  If a prefix is given, crypto processing is toggled."
        (define-key map (kbd "M-RET") 'notmuch-show-open-or-close-all)
        (define-key map (kbd "RET") 'notmuch-show-toggle-message)
        (define-key map "#" 'notmuch-show-print-message)
+       (define-key map "$" 'notmuch-show-toggle-process-crypto)
        map)
       "Keymap for \"notmuch show\" buffers.")
 (fset 'notmuch-show-mode-map notmuch-show-mode-map)
@@ -1181,6 +1186,15 @@ All currently available key bindings:
     (notmuch-show-move-to-message-top)
     t))
 
+(defun notmuch-show-mapc (function)
+  "Iterate through all messages in the current thread with
+`notmuch-show-goto-message-next' and call FUNCTION for side
+effects."
+  (save-excursion
+    (goto-char (point-min))
+    (loop do (funcall function)
+         while (notmuch-show-goto-message-next))))
+
 ;; Functions relating to the visibility of messages and their
 ;; components.
 
@@ -1233,6 +1247,18 @@ Some useful entries are:
   "Return the message id of the current message."
   (concat "id:\"" (notmuch-show-get-prop :id) "\""))
 
+(defun notmuch-show-get-messages-ids ()
+  "Return all message ids of messages in the current thread."
+  (let ((message-ids))
+    (notmuch-show-mapc
+     (lambda () (push (notmuch-show-get-message-id) message-ids)))
+    message-ids))
+
+(defun notmuch-show-get-messages-ids-search ()
+  "Return a search string for all message ids of messages in the
+current thread."
+  (mapconcat 'identity (notmuch-show-get-messages-ids) " or "))
+
 ;; dme: Would it make sense to use a macro for many of these?
 
 (defun notmuch-show-get-filename ()
@@ -1430,7 +1456,8 @@ thread, navigate to the next thread in the parent search buffer."
 
 If a prefix argument is given and this is the last open message
 in the thread, navigate to the next thread in the parent search
-buffer."
+buffer. Return t if there was a next open message in the thread
+to show, nil otherwise."
   (interactive "P")
   (let (r)
     (while (and (setq r (notmuch-show-goto-message-next))
@@ -1441,7 +1468,8 @@ buffer."
          (notmuch-show-message-adjust))
       (if pop-at-end
          (notmuch-show-next-thread)
-       (goto-char (point-max))))))
+       (goto-char (point-max))))
+    r))
 
 (defun notmuch-show-previous-open-message ()
   "Show the previous open message."
@@ -1513,6 +1541,19 @@ TAG-CHANGES is a list of tag operations for `notmuch-tag'."
                      initial-input (notmuch-show-get-message-id))))
     (apply 'notmuch-show-tag-message tag-changes)))
 
+(defun notmuch-show-tag-all (&rest tag-changes)
+  "Change tags for all messages in the current thread.
+
+TAG-CHANGES is a list of tag operations for `notmuch-tag'."
+  (interactive (notmuch-read-tag-changes nil notmuch-show-thread-id))
+  (apply 'notmuch-tag (notmuch-show-get-messages-ids-search) tag-changes)
+  (notmuch-show-mapc
+   (lambda ()
+     (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-add-tag ()
   "Same as `notmuch-show-tag' but sets initial input to '+'."
   (interactive)
@@ -1636,12 +1677,25 @@ removed)."
   (let ((op (if unarchive "+" "-")))
     (notmuch-show-tag-message (concat op "inbox"))))
 
-(defun notmuch-show-archive-message-then-next ()
-  "Archive the current message, then show the next open message in the current thread."
+(defun notmuch-show-archive-message-then-next-or-exit ()
+  "Archive the current message, then show the next open message in the current thread.
+
+If at the last open message in the current thread, then exit back
+to search results."
   (interactive)
   (notmuch-show-archive-message)
   (notmuch-show-next-open-message t))
 
+(defun notmuch-show-archive-message-then-next-or-next-thread ()
+  "Archive the current message, then show the next open message in the current thread.
+
+If at the last open message in the current thread, then show next
+thread from search."
+  (interactive)
+  (notmuch-show-archive-message)
+  (unless (notmuch-show-next-open-message)
+    (notmuch-show-next-thread t)))
+
 (defun notmuch-show-stash-cc ()
   "Copy CC field of current message to kill-ring."
   (interactive)