emacs: add keybind and function to stash Message-ID without prefix

[notmuch] / emacs / notmuch-show.el

diff --git a/emacs/notmuch-show.el b/emacs/notmuch-show.el
index f96743b08d37b597a856ff1a1803f1d325c8c602..d395d8740665661d73bae8ab347092111aef8aca 100644 (file)
--- a/emacs/notmuch-show.el
+++ b/emacs/notmuch-show.el
@@ -27,6 +27,7 @@
 (require 'mm-decode)
 (require 'mailcap)
 (require 'icalendar)
 (require 'mm-decode)
 (require 'mailcap)
 (require 'icalendar)

+(require 'goto-addr)

 
 (require 'notmuch-lib)
 (require 'notmuch-query)
 
 (require 'notmuch-lib)
 (require 'notmuch-query)


@@ -508,21 +509,26 @@ current buffer, if possible."
   t)
 
 (defun notmuch-show-insert-part-message/rfc822 (msg part content-type nth depth declared-type)
   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")))
     ;; 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")
 
     ;; 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)
   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))
 
   "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-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)
 
 ;;;###autoload
 (defun notmuch-show (thread-id &optional parent-buffer query-context buffer-name crypto-switch)


@@ -796,17 +826,23 @@ 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: ")
 when the command is called interactively) the argument to the
 function is used. "
   (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* ((buffer-name (generate-new-buffer-name
+                      (or buffer-name
+                          (concat "*notmuch-" thread-id "*"))))
+        (buffer (get-buffer-create buffer-name))
+        (process-crypto (if crypto-switch
+                            (not notmuch-crypto-process-mime)
+                          notmuch-crypto-process-mime))
+        (inhibit-read-only t))

     (switch-to-buffer buffer)
     (notmuch-show-mode)
     (switch-to-buffer buffer)
     (notmuch-show-mode)

+
+    (setq notmuch-show-thread-id thread-id)

     (setq notmuch-show-parent-buffer parent-buffer)
     (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)
     (setq notmuch-show-process-crypto process-crypto)

+

     (erase-buffer)
     (goto-char (point-min))
     (save-excursion
     (erase-buffer)
     (goto-char (point-min))
     (save-excursion


@@ -822,9 +858,8 @@ function is used. "
          (notmuch-show-insert-forest
           (notmuch-query-get-threads basic-args))))
 
          (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)
 
       ;; Act on visual lines rather than logical lines.
       (visual-line-mode t)
 


@@ -839,6 +874,21 @@ function is used. "
 
     (notmuch-show-mark-read)))
 
 
     (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, the current thread is
+redisplayed with the crypto switch activated, which switch the
+logic of the notmuch-crypto-process-mime customization variable."
+  (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))
+    (notmuch-kill-this-buffer)
+    (notmuch-show thread-id parent-buffer query-context buffer-name crypto-switch)))
+

 (defvar notmuch-show-stash-map
   (let ((map (make-sparse-keymap)))
     (define-key map "c" 'notmuch-show-stash-cc)
 (defvar notmuch-show-stash-map
   (let ((map (make-sparse-keymap)))
     (define-key map "c" 'notmuch-show-stash-cc)


@@ -846,6 +896,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 "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)
     (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 +921,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 "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)
        (define-key map "h" 'notmuch-show-toggle-headers)
        (define-key map "-" 'notmuch-show-remove-tag)
        (define-key map "+" 'notmuch-show-add-tag)


@@ -965,14 +1017,6 @@ All currently available key bindings:
     (notmuch-show-move-to-message-top)
     t))
 
     (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.
 
 ;; Functions relating to the visibility of messages and their
 ;; components.
 


@@ -1101,17 +1145,18 @@ 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."
   (interactive)
 this buffer, and display the next thread from the search from
 which this thread was originally shown."
   (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)))
+    (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
     (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))
 
       ;; The bottom of this message is not visible - scroll.
       (scroll-up nil))
 


@@ -1396,6 +1441,11 @@ buffer."
   (interactive)
   (notmuch-common-do-stash (notmuch-show-get-message-id)))
 
   (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)
 (defun notmuch-show-stash-subject ()
   "Copy Subject field of current message to kill-ring."
   (interactive)