emacs: Rework crypto switch toggle.

Re-work the existing crypto switch toggle to be based on a persistant
buffer-local variable.

To allow this, modify `notmuch-show-refresh-view' to erase and re-draw
in the current buffer rather than killing the current buffer and
creating a new one. (This will also allow more per-buffer behaviour in
future patches.)

Add a binding ('$') to toggle crypto processing of the current buffer
and remove the prefix argument approach that achieves a similar
result.
This commit is contained in:
David Edmondson 2012-02-08 08:02:10 +00:00 committed by David Bremner
parent 5d021e52e2
commit 19ec74c50e
2 changed files with 60 additions and 58 deletions

View file

@ -126,6 +126,22 @@ indentation."
(const :tag "View interactively" (const :tag "View interactively"
notmuch-show-interactively-view-part))) 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) (defmacro with-current-notmuch-show-message (&rest body)
"Evaluate body with current buffer set to the text of current message" "Evaluate body with current buffer set to the text of current message"
`(save-excursion `(save-excursion
@ -611,7 +627,7 @@ current buffer, if possible."
(sigstatus (car (plist-get part :sigstatus)))) (sigstatus (car (plist-get part :sigstatus))))
(notmuch-crypto-insert-sigstatus-button sigstatus from)) (notmuch-crypto-insert-sigstatus-button sigstatus from))
;; if we're not adding sigstatus, tell the user how they can get it ;; 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)) (let ((inner-parts (plist-get part :content))
(start (point))) (start (point)))
@ -637,7 +653,7 @@ current buffer, if possible."
(sigstatus (car (plist-get part :sigstatus)))) (sigstatus (car (plist-get part :sigstatus))))
(notmuch-crypto-insert-sigstatus-button sigstatus from)))) (notmuch-crypto-insert-sigstatus-button sigstatus from))))
;; if we're not adding encstatus, tell the user how they can get it ;; 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)) (let ((inner-parts (plist-get part :content))
(start (point))) (start (point)))
@ -764,8 +780,6 @@ current buffer, if possible."
;; Helper for parts which are generally not included in the default ;; Helper for parts which are generally not included in the default
;; JSON output. ;; 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) (defun notmuch-show-get-bodypart-internal (message-id part-number)
(let ((args '("show" "--format=raw")) (let ((args '("show" "--format=raw"))
(part-arg (format "--part=%s" part-number))) (part-arg (format "--part=%s" part-number)))
@ -919,6 +933,15 @@ current buffer, if possible."
;; criteria. ;; criteria.
(notmuch-show-message-visible msg (plist-get msg :match)))) (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) (defun notmuch-show-insert-tree (tree depth)
"Insert the message tree TREE at depth DEPTH in the current thread." "Insert the message tree TREE at depth DEPTH in the current thread."
(let ((msg (car tree)) (let ((msg (car tree))
@ -934,15 +957,6 @@ current buffer, if possible."
"Insert the forest of threads FOREST." "Insert the forest of threads FOREST."
(mapc (lambda (thread) (notmuch-show-insert-thread thread 0)) 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) (defun notmuch-show-buttonise-links (start end)
"Buttonise URLs and mail addresses between START and END. "Buttonise URLs and mail addresses between START and END.
@ -962,7 +976,7 @@ a corresponding notmuch search."
'face goto-address-mail-face)))) 'face goto-address-mail-face))))
;;;###autoload ;;;###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. "Run \"notmuch show\" with the given thread ID and display results.
The optional PARENT-BUFFER is the notmuch-search buffer from 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 The optional BUFFER-NAME provides the name of the buffer in
which the message thread is shown. If it is nil (which occurs which the message thread is shown. If it is nil (which occurs
when the command is called interactively) the argument to the when the command is called interactively) the argument to the
function is used. function is used."
The optional CRYPTO-SWITCH toggles the value of the
notmuch-crypto-process-mime customization variable for this show
buffer."
(interactive "sNotmuch show: ") (interactive "sNotmuch show: ")
(let* ((process-crypto (if crypto-switch (let ((buffer-name (generate-new-buffer-name
(not notmuch-crypto-process-mime) (or buffer-name
notmuch-crypto-process-mime))) (concat "*notmuch-" thread-id "*")))))
(notmuch-show-worker thread-id parent-buffer query-context buffer-name process-crypto))) (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))
(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)
(notmuch-show-mode) (notmuch-show-mode)
;; Don't track undo information for this buffer ;; Don't track undo information for this buffer
(set 'buffer-undo-list t) (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) (erase-buffer)
(goto-char (point-min)) (goto-char (point-min))
(save-excursion (save-excursion
(let* ((basic-args (list thread-id)) (let* ((basic-args (list notmuch-show-thread-id))
(args (if query-context (args (if notmuch-show-query-context
(append (list "\'") basic-args (list "and (" query-context ")\'")) (append (list "\'") basic-args
(list "and (" notmuch-show-query-context ")\'"))
(append (list "\'") basic-args (list "\'"))))) (append (list "\'") basic-args (list "\'")))))
(notmuch-show-insert-forest (notmuch-query-get-threads args)) (notmuch-show-insert-forest (notmuch-query-get-threads args))
;; If the query context reduced the results to nothing, run ;; If the query context reduced the results to nothing, run
;; the basic query. ;; the basic query.
(when (and (eq (buffer-size) 0) (when (and (eq (buffer-size) 0)
query-context) notmuch-show-query-context)
(notmuch-show-insert-forest (notmuch-show-insert-forest
(notmuch-query-get-threads basic-args)))) (notmuch-query-get-threads basic-args))))
@ -1033,21 +1042,14 @@ buffer."
(notmuch-show-mark-read))) (notmuch-show-mark-read)))
(defun notmuch-show-refresh-view (&optional crypto-switch) (defun notmuch-show-refresh-view ()
"Refresh the current view (with crypto switch if prefix given). "Refresh the current view.
Kills the current buffer and reruns notmuch show with the same Refreshes the current view, observing changes in cryptographic preferences."
thread id. If a prefix is given, crypto processing is toggled." (interactive)
(interactive "P") (let ((inhibit-read-only t))
(let ((thread-id notmuch-show-thread-id) (erase-buffer))
(parent-buffer notmuch-show-parent-buffer) (notmuch-show-worker))
(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)))
(defvar notmuch-show-stash-map (defvar notmuch-show-stash-map
(let ((map (make-sparse-keymap))) (let ((map (make-sparse-keymap)))
@ -1100,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 "M-RET") 'notmuch-show-open-or-close-all)
(define-key map (kbd "RET") 'notmuch-show-toggle-message) (define-key map (kbd "RET") 'notmuch-show-toggle-message)
(define-key map "#" 'notmuch-show-print-message) (define-key map "#" 'notmuch-show-print-message)
(define-key map "$" 'notmuch-show-toggle-process-crypto)
map) map)
"Keymap for \"notmuch show\" buffers.") "Keymap for \"notmuch show\" buffers.")
(fset 'notmuch-show-mode-map notmuch-show-mode-map) (fset 'notmuch-show-mode-map notmuch-show-mode-map)

View file

@ -494,9 +494,9 @@ Complete list of currently available key bindings:
"Return a list of authors for the current region" "Return a list of authors for the current region"
(notmuch-search-properties-in-region 'notmuch-search-subject beg end)) (notmuch-search-properties-in-region 'notmuch-search-subject beg end))
(defun notmuch-search-show-thread (&optional crypto-switch) (defun notmuch-search-show-thread ()
"Display the currently selected thread." "Display the currently selected thread."
(interactive "P") (interactive)
(let ((thread-id (notmuch-search-find-thread-id)) (let ((thread-id (notmuch-search-find-thread-id))
(subject (notmuch-prettify-subject (notmuch-search-find-subject)))) (subject (notmuch-prettify-subject (notmuch-search-find-subject))))
(if (> (length thread-id) 0) (if (> (length thread-id) 0)
@ -504,8 +504,7 @@ Complete list of currently available key bindings:
(current-buffer) (current-buffer)
notmuch-search-query-string notmuch-search-query-string
;; Name the buffer based on the subject. ;; Name the buffer based on the subject.
(concat "*" (truncate-string-to-width subject 30 nil nil t) "*") (concat "*" (truncate-string-to-width subject 30 nil nil t) "*"))
crypto-switch)
(message "End of search results.")))) (message "End of search results."))))
(defun notmuch-search-reply-to-thread (&optional prompt-for-sender) (defun notmuch-search-reply-to-thread (&optional prompt-for-sender)