]> git.notmuchmail.org Git - notmuch/blobdiff - notmuch.el
notmuch.el: add a submap (on "z" for "ztash") to stash things.
[notmuch] / notmuch.el
index 6c9004ecfa0307519d4acd16ea8c7c580ffba2d0..97f7e0c8fcfbc2473c145b79e530845c4b3d96a2 100644 (file)
 (require 'mm-view)
 (require 'message)
 
+(defvar notmuch-show-stash-map
+  (let ((map (make-sparse-keymap)))
+    (define-key map "c" 'notmuch-show-stash-cc)
+    (define-key map "d" 'notmuch-show-stash-date)
+    (define-key map "F" 'notmuch-show-stash-filename)
+    (define-key map "f" 'notmuch-show-stash-from)
+    (define-key map "m" 'notmuch-show-stash-message-id)
+    (define-key map "s" 'notmuch-show-stash-subject)
+    (define-key map "T" 'notmuch-show-stash-tags)
+    (define-key map "t" 'notmuch-show-stash-to)
+    map)
+  "Submap for stash commands"
+  )
+
+(fset 'notmuch-show-stash-map notmuch-show-stash-map)
+
 (defvar notmuch-show-mode-map
   (let ((map (make-sparse-keymap)))
     (define-key map "?" 'notmuch-help)
@@ -80,6 +96,7 @@
     (define-key map "n" 'notmuch-show-next-message)
     (define-key map (kbd "DEL") 'notmuch-show-rewind)
     (define-key map " " 'notmuch-show-advance-marking-read-and-archiving)
+    (define-key map "z" 'notmuch-show-stash-map)
     map)
   "Keymap for \"notmuch show\" buffers.")
 (fset 'notmuch-show-mode-map notmuch-show-mode-map)
@@ -133,6 +150,8 @@ remaining lines into a button.")
 (defvar notmuch-show-id-regexp "\\(id:[^ ]*\\)")
 (defvar notmuch-show-depth-match-regexp " depth:\\([0-9]*\\).*match:\\([01]\\) ")
 (defvar notmuch-show-filename-regexp "filename:\\(.*\\)$")
+(defvar notmuch-show-contentype-regexp "Content-type: \\(.*\\)")
+
 (defvar notmuch-show-tags-regexp "(\\([^)]*\\))$")
 
 (defvar notmuch-show-parent-buffer nil)
@@ -223,6 +242,62 @@ Unlike builtin `previous-line' this version accepts no arguments."
     (re-search-forward notmuch-show-tags-regexp)
     (split-string (buffer-substring (match-beginning 1) (match-end 1)))))
 
+(defun notmuch-show-get-bcc ()
+  "Return BCC address(es) of current message"
+  (notmuch-show-get-header-field 'bcc))
+
+(defun notmuch-show-get-cc ()
+  "Return CC address(es) of current message"
+  (notmuch-show-get-header-field 'cc))
+
+(defun notmuch-show-get-date ()
+  "Return Date of current message"
+  (notmuch-show-get-header-field 'date))
+
+(defun notmuch-show-get-from ()
+  "Return From address of current message"
+  (notmuch-show-get-header-field 'from))
+
+(defun notmuch-show-get-subject ()
+  "Return Subject of current message"
+  (notmuch-show-get-header-field 'subject))
+
+(defun notmuch-show-get-to ()
+  "Return To address(es) of current message"
+  (notmuch-show-get-header-field 'to))
+
+(defun notmuch-show-get-header-field (name)
+  "Retrieve the header field NAME from the current message.
+NAME should be a symbol, in lower case, as returned by
+mail-header-extract-no-properties"
+  (let* ((result (assoc name (notmuch-show-get-header)))
+        (val (and result (cdr result))))
+    val))
+
+(defun notmuch-show-get-header ()
+  "Retrieve and parse the header from the current message. Returns an alist with of (header . value)
+where header is a symbol and value is a string.  The summary from notmuch-show is returned as the
+pseudoheader summary"
+  (require 'mailheader)
+  (save-excursion
+    (beginning-of-line)
+    (if (not (looking-at notmuch-show-message-begin-regexp))
+       (re-search-backward notmuch-show-message-begin-regexp))
+    (re-search-forward (concat notmuch-show-header-begin-regexp "\n[[:space:]]*\\(.*\\)\n"))
+    (let* ((summary (buffer-substring-no-properties (match-beginning 1) (match-end 1)))
+         (beg (point)))
+      (re-search-forward notmuch-show-header-end-regexp)
+      (let ((text (buffer-substring beg (match-beginning 0))))
+       (with-temp-buffer
+         (insert text)
+         (goto-char (point-min))
+         (while (looking-at "\\([[:space:]]*\\)[A-Za-z][-A-Za-z0-9]*:")
+           (delete-region (match-beginning 1) (match-end 1))
+           (forward-line)
+           )
+         (goto-char (point-min))
+         (cons (cons 'summary summary) (mail-header-extract-no-properties)))))))
+
 (defun notmuch-show-add-tag (&rest toadd)
   "Add a tag to the current message."
   (interactive
@@ -319,13 +394,28 @@ buffer."
          (with-current-buffer buf
            (insert-file-contents filename nil nil nil t)
            ,@body)
-        (kill-buffer buf)))))
+        (kill-buffer buf)))))
 
 (defun notmuch-show-view-all-mime-parts ()
   "Use external viewers to view all attachments from the current message."
   (interactive)
   (with-current-notmuch-show-message
-   (mm-display-parts (mm-dissect-buffer))))
+   ; We ovverride 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
+   ; with-current-notmuch-show-message and silently discarded.
+   ;
+   ; Any MIME part not explicitly mentioned here will be handled by an
+   ; external viewer as configured in the various mailcap files.
+   (let ((mm-inline-media-tests '(
+                                 ("text/.*" ignore identity)
+                                 ("application/pgp-signature" ignore identity)
+                                 ("multipart/alternative" ignore identity)
+                                 ("multipart/mixed" ignore identity)
+                                 ("multipart/related" ignore identity)
+                                )))
+     (mm-display-parts (mm-dissect-buffer)))))
 
 (defun notmuch-foreach-mime-part (function mm-handle)
   (cond ((stringp (car mm-handle))
@@ -713,19 +803,44 @@ is what to put on the button."
 (defun notmuch-show-markup-part (beg end depth)
   (if (re-search-forward notmuch-show-part-begin-regexp nil t)
       (progn
-       (forward-line)
-       (let ((beg (point-marker)))
-         (re-search-forward notmuch-show-part-end-regexp)
-         (let ((end (copy-marker (match-beginning 0))))
-           (goto-char end)
-           (if (not (bolp))
-               (insert "\n"))
-           (indent-rigidly beg end depth)
-           (notmuch-show-markup-citations-region beg end depth)
-           ; Advance to the next part (if any) (so the outer loop can
-           ; determine whether we've left the current message.
-           (if (re-search-forward notmuch-show-part-begin-regexp nil t)
-               (beginning-of-line)))))
+        (let (mime-message mime-type)
+          (save-excursion
+            (re-search-forward notmuch-show-contentype-regexp end t)
+            (setq mime-type (car (split-string (buffer-substring
+                                                (match-beginning 1) (match-end 1))))))
+
+          (if (equal mime-type "text/html")
+              (let ((filename (notmuch-show-get-filename)))
+                (with-temp-buffer
+                  (insert-file-contents filename nil nil nil t)
+                  (setq mime-message (mm-dissect-buffer)))))
+          (forward-line)
+          (let ((beg (point-marker)))
+            (re-search-forward notmuch-show-part-end-regexp)
+            (let ((end (copy-marker (match-beginning 0))))
+              (goto-char end)
+              (if (not (bolp))
+                  (insert "\n"))
+              (indent-rigidly beg end depth)
+              (if (not (eq mime-message nil))
+                  (save-excursion
+                    (goto-char beg)
+                    (forward-line -1)
+                    (let ((handle-type (mm-handle-type mime-message))
+                          mime-type)
+                      (if (sequencep (car handle-type))
+                          (setq mime-type (car handle-type))
+                        (setq mime-type (car (car (cdr handle-type))))
+                        )
+                      (if (equal mime-type "text/html")
+                          (mm-display-part mime-message))))
+                )
+              (notmuch-show-markup-citations-region beg end depth)
+              ; Advance to the next part (if any) (so the outer loop can
+              ; determine whether we've left the current message.
+              (if (re-search-forward notmuch-show-part-begin-regexp nil t)
+                  (beginning-of-line)))))
+        (goto-char end))
     (goto-char end)))
 
 (defun notmuch-show-markup-parts-region (beg end depth)
@@ -902,8 +1017,12 @@ For a mouse binding, return nil."
     (if (mouse-event-p key)
        nil
       (if (keymapp action)
-         (let ((substitute (apply-partially 'notmuch-substitute-one-command-key-with-prefix (notmuch-prefix-key-description key))))
-           (mapconcat substitute (cdr action) "\n"))
+         (let ((substitute (apply-partially 'notmuch-substitute-one-command-key-with-prefix (notmuch-prefix-key-description key)))
+               (as-list))
+           (map-keymap (lambda (a b)
+                         (push (cons a b) as-list))
+                       action)
+           (mapconcat substitute as-list "\n"))
        (concat prefix (format-kbd-macro (vector key))
                "\t"
                (notmuch-documentation-first-line action))))))
@@ -988,6 +1107,50 @@ All currently available key bindings:
   :options '(hl-line-mode)
   :group 'notmuch)
 
+(defun notmuch-show-do-stash (text)
+    (kill-new text)
+    (message (concat "Saved: " text)))
+
+(defun notmuch-show-stash-cc ()
+  "Copy CC field of current message to kill-ring."
+  (interactive)
+  (notmuch-show-do-stash (notmuch-show-get-cc)))
+
+(defun notmuch-show-stash-date ()
+  "Copy date of current message to kill-ring."
+  (interactive)
+  (notmuch-show-do-stash (notmuch-show-get-date)))
+
+(defun notmuch-show-stash-filename ()
+  "Copy filename of current message to kill-ring."
+  (interactive)
+  (notmuch-show-do-stash (notmuch-show-get-filename)))
+
+(defun notmuch-show-stash-from ()
+  "Copy From address of current message to kill-ring."
+  (interactive)
+  (notmuch-show-do-stash (notmuch-show-get-from)))
+
+(defun notmuch-show-stash-message-id ()
+  "Copy message-id of current message to kill-ring."
+  (interactive)
+  (notmuch-show-do-stash (notmuch-show-get-message-id)))
+
+(defun notmuch-show-stash-subject ()
+  "Copy Subject field of current message to kill-ring."
+  (interactive)
+  (notmuch-show-do-stash (notmuch-show-get-subject)))
+
+(defun notmuch-show-stash-tags ()
+  "Copy tags of current message to kill-ring as a comma separated list."
+  (interactive)
+  (notmuch-show-do-stash (mapconcat 'identity (notmuch-show-get-tags) ",")))
+
+(defun notmuch-show-stash-to ()
+  "Copy To address of current message to kill-ring."
+  (interactive)
+  (notmuch-show-do-stash (notmuch-show-get-to)))
+
 ; Make show mode a bit prettier, highlighting URLs and using word wrap
 
 (defun notmuch-show-pretty-hook ()
@@ -1308,7 +1471,7 @@ This function advances the next thread when finished."
                  (more t)
                  (inhibit-read-only t))
              (while more
-               (if (string-match "^\\(thread:[0-9A-Fa-f]*\\) \\(.*\\) \\(\\[[0-9/]*\\]\\) \\([^:]*\\); \\(.*\\) (\\([^()]*\\))$" string line)
+               (if (string-match "^\\(thread:[0-9A-Fa-f]*\\) \\(.*\\) \\(\\[[0-9/]*\\]\\) \\([^;]*\\); \\(.*\\) (\\([^()]*\\))$" string line)
                    (let* ((thread-id (match-string 1 string))
                           (date (match-string 2 string))
                           (count (match-string 3 string))