]> git.notmuchmail.org Git - notmuch/blobdiff - emacs/notmuch-show.el
emacs: Don't record undo information for search or show buffers.
[notmuch] / emacs / notmuch-show.el
index 452987839270909422d3a6d28e1981a7f27228fa..7be88f828b97ad927ab20d4763914dd03b8ed645 100644 (file)
@@ -27,6 +27,7 @@
 (require 'mm-decode)
 (require 'mailcap)
 (require 'icalendar)
+(require 'goto-addr)
 
 (require 'notmuch-lib)
 (require 'notmuch-query)
@@ -110,7 +111,7 @@ any given message."
   "Use external viewers to view all attachments from the current message."
   (interactive)
   (with-current-notmuch-show-message
-   ; We ovverride the mm-inline-media-tests to indicate which message
+   ; We override the mm-inline-media-tests to indicate which message
    ; parts are already sufficiently handled by the original
    ; presentation of the message in notmuch-show mode. These parts
    ; will be inserted directly into the temporary buffer of
@@ -508,21 +509,26 @@ current buffer, if possible."
   t)
 
 (defun notmuch-show-insert-part-message/rfc822 (msg part content-type nth depth declared-type)
-  (let* ((message-part (plist-get part :content))
-        (inner-parts (plist-get message-part :content)))
-    (notmuch-show-insert-part-header nth declared-type content-type nil)
+  (notmuch-show-insert-part-header nth declared-type content-type nil)
+  (let* ((message (car (plist-get part :content)))
+        (headers (plist-get message :headers))
+        (body (car (plist-get message :body)))
+        (start (point)))
+
     ;; Override `notmuch-message-headers' to force `From' to be
     ;; displayed.
     (let ((notmuch-message-headers '("From" "Subject" "To" "Cc" "Date")))
-      (notmuch-show-insert-headers (plist-get part :headers)))
+      (notmuch-show-insert-headers (plist-get message :headers)))
+
     ;; Blank line after headers to be compatible with the normal
     ;; message display.
     (insert "\n")
 
-    ;; Show all of the parts.
-    (mapc (lambda (inner-part)
-           (notmuch-show-insert-bodypart msg inner-part depth))
-         inner-parts))
+    ;; Show the body
+    (notmuch-show-insert-bodypart msg body depth)
+
+    (when notmuch-show-indent-multipart
+      (indent-rigidly start (point) 1)))
   t)
 
 (defun notmuch-show-insert-part-text/plain (msg part content-type nth depth declared-type)
@@ -775,8 +781,32 @@ 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.
+
+This also turns id:\"<message id>\"-parts into buttons for
+a corresponding notmuch search."
+  (goto-address-fontify-region start end)
+  (save-excursion
+    (goto-char start)
+    (while (re-search-forward "id:\\(\"?\\)[^[:space:]\"]+\\1" end t)
+      ;; remove the overlay created by goto-address-mode
+      (remove-overlays (match-beginning 0) (match-end 0) 'goto-address t)
+      (make-text-button (match-beginning 0) (match-end 0)
+                       'action `(lambda (arg)
+                                  (notmuch-search ,(match-string-no-properties 0)))
+                       '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 crypto-switch)
@@ -791,22 +821,37 @@ The optional QUERY-CONTEXT is a notmuch search term. Only
 messages from the thread matching this search term are shown if
 non-nil.
 
-The optional BUFFER-NAME provides the neame 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
 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: ")
-  (let ((buffer (get-buffer-create (generate-new-buffer-name
-                                   (or buffer-name
-                                       (concat "*notmuch-" thread-id "*")))))
-       (process-crypto (if crypto-switch
-                           (not notmuch-crypto-process-mime)
-                         notmuch-crypto-process-mime))
-       (inhibit-read-only t))
+  (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)
     (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
@@ -822,9 +867,8 @@ function is used. "
          (notmuch-show-insert-forest
           (notmuch-query-get-threads basic-args))))
 
-      ;; Enable buttonisation of URLs and email addresses in the
-      ;; buffer.
-      (goto-address-mode t)
+      (jit-lock-register #'notmuch-show-buttonise-links)
+
       ;; Act on visual lines rather than logical lines.
       (visual-line-mode t)
 
@@ -839,6 +883,22 @@ function is used. "
 
     (notmuch-show-mark-read)))
 
+(defun notmuch-show-refresh-view (&optional crypto-switch)
+  "Refresh the current view (with crypto switch if prefix given).
+
+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)))
+
 (defvar notmuch-show-stash-map
   (let ((map (make-sparse-keymap)))
     (define-key map "c" 'notmuch-show-stash-cc)
@@ -846,6 +906,7 @@ function is used. "
     (define-key map "F" 'notmuch-show-stash-filename)
     (define-key map "f" 'notmuch-show-stash-from)
     (define-key map "i" 'notmuch-show-stash-message-id)
+    (define-key map "I" 'notmuch-show-stash-message-id-stripped)
     (define-key map "s" 'notmuch-show-stash-subject)
     (define-key map "T" 'notmuch-show-stash-tags)
     (define-key map "t" 'notmuch-show-stash-to)
@@ -870,6 +931,7 @@ function is used. "
        (define-key map "V" 'notmuch-show-view-raw-message)
        (define-key map "v" 'notmuch-show-view-all-mime-parts)
        (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-remove-tag)
        (define-key map "+" 'notmuch-show-add-tag)
@@ -909,7 +971,7 @@ more selectively, (such as '\\[notmuch-show-next-message]' and '\\[notmuch-show-
 without removing any tags, and '\\[notmuch-show-archive-thread]' to archive an entire thread
 without scrolling through with \\[notmuch-show-advance-and-archive]).
 
-You can add or remove arbitary tags from the current message with
+You can add or remove arbitrary tags from the current message with
 '\\[notmuch-show-add-tag]' or '\\[notmuch-show-remove-tag]'.
 
 All currently available key bindings:
@@ -965,14 +1027,6 @@ All currently available key bindings:
     (notmuch-show-move-to-message-top)
     t))
 
-(defun notmuch-show-move-past-invisible-forward ()
-  (while (point-invisible-p)
-    (forward-char)))
-
-(defun notmuch-show-move-past-invisible-backward ()
-  (while (point-invisible-p)
-    (backward-char)))
-
 ;; Functions relating to the visibility of messages and their
 ;; components.
 
@@ -1083,35 +1137,28 @@ All currently available key bindings:
 
 ;; Commands typically bound to keys.
 
-(defun notmuch-show-advance-and-archive ()
-  "Advance through thread and archive.
-
-This command is intended to be one of the simplest ways to
-process a thread of email. It does the following:
+(defun notmuch-show-advance ()
+  "Advance through thread.
 
 If the current message in the thread is not yet fully visible,
 scroll by a near screenful to read more of the message.
 
 Otherwise, (the end of the current message is already within the
-current window), advance to the next open message.
-
-Finally, if there is no further message to advance to, and this
-last message is already read, then archive the entire current
-thread, (remove the \"inbox\" tag from each message). Also kill
-this buffer, and display the next thread from the search from
-which this thread was originally shown."
+current window), advance to the next open message."
   (interactive)
-  (let ((end-of-this-message (notmuch-show-message-bottom)))
+  (let* ((end-of-this-message (notmuch-show-message-bottom))
+        (visible-end-of-this-message (1- end-of-this-message))
+        (ret nil))
+    (while (invisible-p visible-end-of-this-message)
+      (setq visible-end-of-this-message
+           (previous-single-char-property-change visible-end-of-this-message
+                                                 'invisible)))
     (cond
      ;; Ideally we would test `end-of-this-message' against the result
      ;; of `window-end', but that doesn't account for the fact that
-     ;; the end of the message might be hidden, so we have to actually
-     ;; go to the end, walk back over invisible text and then see if
-     ;; point is visible.
-     ((save-excursion
-       (goto-char (- end-of-this-message 1))
-       (notmuch-show-move-past-invisible-backward)
-       (> (point) (window-end)))
+     ;; the end of the message might be hidden.
+     ((and visible-end-of-this-message
+          (> visible-end-of-this-message (window-end)))
       ;; The bottom of this message is not visible - scroll.
       (scroll-up nil))
 
@@ -1120,8 +1167,24 @@ which this thread was originally shown."
       (notmuch-show-next-open-message))
 
      (t
-      ;; This is the last message - archive the thread.
-      (notmuch-show-archive-thread)))))
+      ;; This is the last message - change the return value
+      (setq ret t)))
+    ret))
+
+(defun notmuch-show-advance-and-archive ()
+  "Advance through thread and archive.
+
+This command is intended to be one of the simplest ways to
+process a thread of email. It works exactly like
+notmuch-show-advance, in that it scrolls through messages in a
+show buffer, except that when it gets to the end of the buffer it
+archives the entire current thread, (remove the \"inbox\" tag
+from each message), kills the buffer, and displays the next
+thread from the search from which this thread was originally
+shown."
+  (interactive)
+  (if (notmuch-show-advance)
+      (notmuch-show-archive-thread)))
 
 (defun notmuch-show-rewind ()
   "Backup through the thread, (reverse scrolling compared to \\[notmuch-show-advance-and-archive]).
@@ -1396,6 +1459,11 @@ buffer."
   (interactive)
   (notmuch-common-do-stash (notmuch-show-get-message-id)))
 
+(defun notmuch-show-stash-message-id-stripped ()
+  "Copy message ID of current message (sans `id:' prefix) to kill-ring."
+  (interactive)
+  (notmuch-common-do-stash (substring (notmuch-show-get-message-id) 4 -1)))
+
 (defun notmuch-show-stash-subject ()
   "Copy Subject field of current message to kill-ring."
   (interactive)