Key binding rearrangement for save attachments in show mode

[notmuch] / notmuch.el

diff --git a/notmuch.el b/notmuch.el
index 1574111b9b35f487d77d534d06da8906965b7808..fecad676a269e1fe7d0fa38b6492fb611bfc8bc6 100644 (file)
--- a/notmuch.el
+++ b/notmuch.el
@@ -49,6 +49,7 @@
 
 (require 'cl)
 (require 'mm-view)
 
 (require 'cl)
 (require 'mm-view)

+(require 'message)

 
 (defvar notmuch-show-mode-map
   (let ((map (make-sparse-keymap)))
 
 (defvar notmuch-show-mode-map
   (let ((map (make-sparse-keymap)))


@@ -61,6 +62,7 @@
     ; overlays-at to query and manipulate the current overlay.
     (define-key map "a" 'notmuch-show-archive-thread)
     (define-key map "A" 'notmuch-show-mark-read-then-archive-thread)
     ; overlays-at to query and manipulate the current overlay.
     (define-key map "a" 'notmuch-show-archive-thread)
     (define-key map "A" 'notmuch-show-mark-read-then-archive-thread)

+    (define-key map "f" 'notmuch-show-forward-current)

     (define-key map "m" 'message-mail)
     (define-key map "n" 'notmuch-show-next-message)
     (define-key map "N" 'notmuch-show-mark-read-then-next-open-message)
     (define-key map "m" 'message-mail)
     (define-key map "n" 'notmuch-show-next-message)
     (define-key map "N" 'notmuch-show-mark-read-then-next-open-message)


@@ -69,8 +71,10 @@
     (define-key map (kbd "C-p") 'notmuch-show-previous-line)
     (define-key map "q" 'kill-this-buffer)
     (define-key map "r" 'notmuch-show-reply)
     (define-key map (kbd "C-p") 'notmuch-show-previous-line)
     (define-key map "q" 'kill-this-buffer)
     (define-key map "r" 'notmuch-show-reply)

+    (define-key map "s" 'notmuch-search)

     (define-key map "v" 'notmuch-show-view-all-mime-parts)
     (define-key map "v" 'notmuch-show-view-all-mime-parts)

-    (define-key map "w" 'notmuch-show-view-raw-message)
+    (define-key map "V" 'notmuch-show-view-raw-message)
+    (define-key map "w" 'notmuch-show-save-attachments)

     (define-key map "x" 'kill-this-buffer)
     (define-key map "+" 'notmuch-show-add-tag)
     (define-key map "-" 'notmuch-show-remove-tag)
     (define-key map "x" 'kill-this-buffer)
     (define-key map "+" 'notmuch-show-add-tag)
     (define-key map "-" 'notmuch-show-remove-tag)


@@ -137,11 +141,11 @@ within the current window."
       (or (memq prop buffer-invisibility-spec)
          (assq prop buffer-invisibility-spec)))))
 
       (or (memq prop buffer-invisibility-spec)
          (assq prop buffer-invisibility-spec)))))
 

-(defun notmuch-select-tag-with-completion (prompt)
+(defun notmuch-select-tag-with-completion (prompt &rest search-terms)

   (let ((tag-list
         (with-output-to-string
           (with-current-buffer standard-output
   (let ((tag-list
         (with-output-to-string
           (with-current-buffer standard-output

-            (call-process notmuch-command nil t nil "search-tags")))))
+            (apply 'call-process notmuch-command nil t nil "search-tags" search-terms)))))

     (completing-read prompt (split-string tag-list "\n+" t) nil nil nil)))
 
 (defun notmuch-show-next-line ()
     (completing-read prompt (split-string tag-list "\n+" t) nil nil nil)))
 
 (defun notmuch-show-next-line ()


@@ -174,7 +178,7 @@ Unlike builtin `next-line' this version accepts no arguments."
     (if (not (looking-at notmuch-show-message-begin-regexp))
        (re-search-backward notmuch-show-message-begin-regexp))
     (re-search-forward notmuch-show-id-regexp)
     (if (not (looking-at notmuch-show-message-begin-regexp))
        (re-search-backward notmuch-show-message-begin-regexp))
     (re-search-forward notmuch-show-id-regexp)

-    (buffer-substring (match-beginning 1) (match-end 1))))
+    (buffer-substring-no-properties (match-beginning 1) (match-end 1))))

 
 (defun notmuch-show-get-filename ()
   (save-excursion
 
 (defun notmuch-show-get-filename ()
   (save-excursion


@@ -182,7 +186,7 @@ Unlike builtin `next-line' this version accepts no arguments."
     (if (not (looking-at notmuch-show-message-begin-regexp))
        (re-search-backward notmuch-show-message-begin-regexp))
     (re-search-forward notmuch-show-filename-regexp)
     (if (not (looking-at notmuch-show-message-begin-regexp))
        (re-search-backward notmuch-show-message-begin-regexp))
     (re-search-forward notmuch-show-filename-regexp)

-    (buffer-substring (match-beginning 1) (match-end 1))))
+    (buffer-substring-no-properties (match-beginning 1) (match-end 1))))

 
 (defun notmuch-show-set-tags (tags)
   (save-excursion
 
 (defun notmuch-show-set-tags (tags)
   (save-excursion


@@ -218,7 +222,7 @@ Unlike builtin `next-line' this version accepts no arguments."
 (defun notmuch-show-remove-tag (&rest toremove)
   "Remove a tag from the current message."
   (interactive
 (defun notmuch-show-remove-tag (&rest toremove)
   "Remove a tag from the current message."
   (interactive

-   (list (notmuch-select-tag-with-completion "Tag to remove: ")))
+   (list (notmuch-select-tag-with-completion "Tag to remove: " (notmuch-show-get-message-id))))

   (let ((tags (notmuch-show-get-tags)))
     (if (intersection tags toremove :test 'string=)
        (progn
   (let ((tags (notmuch-show-get-tags)))
     (if (intersection tags toremove :test 'string=)
        (progn


@@ -281,17 +285,62 @@ buffer."
   (interactive)
   (view-file (notmuch-show-get-filename)))
 
   (interactive)
   (view-file (notmuch-show-get-filename)))
 

+(defmacro with-current-notmuch-show-message (&rest body)
+  "Evaluate body with current buffer set to the text of current message"
+  `(save-excursion
+     (let ((filename (notmuch-show-get-filename)))
+       (let ((buf (generate-new-buffer (concat "*notmuch-msg-" filename "*"))))
+         (with-current-buffer buf
+           (insert-file-contents filename nil nil nil t)
+           ,@body)
+        (kill-buffer buf)))))
+

 (defun notmuch-show-view-all-mime-parts ()
   "Use external viewers (according to mailcap) to view all MIME-encoded parts."
   (interactive)
 (defun notmuch-show-view-all-mime-parts ()
   "Use external viewers (according to mailcap) to view all MIME-encoded parts."
   (interactive)

-  (save-excursion
-    (let ((filename (notmuch-show-get-filename)))
-      (switch-to-buffer (generate-new-buffer (concat "*notmuch-mime-"
-                                                    filename
-                                                    "*")))
-      (insert-file-contents filename nil nil nil t)
-      (mm-display-parts (mm-dissect-buffer))
-      (kill-this-buffer))))
+  (with-current-notmuch-show-message
+   (mm-display-parts (mm-dissect-buffer))))
+
+(defun notmuch-foreach-mime-part (function mm-handle)
+  (cond ((stringp (car mm-handle))
+         (dolist (part (cdr mm-handle))
+           (notmuch-foreach-mime-part function part)))
+        ((bufferp (car mm-handle))
+         (funcall function mm-handle))
+        (t (dolist (part mm-handle)
+             (notmuch-foreach-mime-part function part)))))
+
+(defun notmuch-count-attachments (mm-handle)
+  (let ((count 0))
+    (notmuch-foreach-mime-part
+     (lambda (p)
+       (let ((disposition (mm-handle-disposition p)))
+         (and (listp disposition)
+              (equal (car disposition) "attachment")
+              (incf count))))
+     mm-handle)
+    count))
+
+(defun notmuch-save-attachments (mm-handle &optional queryp)
+  (notmuch-foreach-mime-part
+   (lambda (p)
+     (let ((disposition (mm-handle-disposition p)))
+       (and (listp disposition)
+            (equal (car disposition) "attachment")
+            (or (not queryp)
+                (y-or-n-p
+                 (concat "Save '" (cdr (assq 'filename disposition)) "' ")))
+            (mm-save-part p))))
+   mm-handle))
+
+(defun notmuch-show-save-attachments ()
+  "Save the attachments to a message"
+  (interactive)
+  (with-current-notmuch-show-message
+   (let ((mm-handle (mm-dissect-buffer)))
+     (notmuch-save-attachments
+      mm-handle (> (notmuch-count-attachments mm-handle) 1))))
+  (message "Done"))

 
 (defun notmuch-reply (query-string)
   (switch-to-buffer (generate-new-buffer "notmuch-draft"))
 
 (defun notmuch-reply (query-string)
   (switch-to-buffer (generate-new-buffer "notmuch-draft"))


@@ -310,6 +359,12 @@ buffer."
   (let ((message-id (notmuch-show-get-message-id)))
     (notmuch-reply message-id)))
 
   (let ((message-id (notmuch-show-get-message-id)))
     (notmuch-reply message-id)))
 

+(defun notmuch-show-forward-current ()
+  "Forward a the current message."
+  (interactive)
+  (with-current-notmuch-show-message
+   (message-forward)))
+

 (defun notmuch-show-pipe-message (command)
   "Pipe the contents of the current message to the given command.
 
 (defun notmuch-show-pipe-message (command)
   "Pipe the contents of the current message to the given command.
 


@@ -563,29 +618,52 @@ which this thread was originally shown."
                     (goto-char end))))))
       (forward-line))))
 
                     (goto-char end))))))
       (forward-line))))
 

-(defun notmuch-show-markup-part (beg end depth)
+(defun notmuch-show-markup-part (beg end depth mime-message)

   (if (re-search-forward notmuch-show-part-begin-regexp nil t)
       (progn
   (if (re-search-forward notmuch-show-part-begin-regexp nil t)
       (progn

+        (if (eq mime-message nil)
+            (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)
        (forward-line)

-       (let ((beg (point-marker)))
+       (let ((part-beg (point-marker)))

          (re-search-forward notmuch-show-part-end-regexp)
          (re-search-forward notmuch-show-part-end-regexp)

-         (let ((end (copy-marker (match-beginning 0))))
-           (goto-char end)
+
+         (let ((part-end (copy-marker (match-beginning 0))))
+           (goto-char part-end)

            (if (not (bolp))
                (insert "\n"))
            (if (not (bolp))
                (insert "\n"))

-           (indent-rigidly beg end depth)
-           (notmuch-show-markup-citations-region beg end depth)
+           (indent-rigidly part-beg part-end depth)
+            (save-excursion
+              (goto-char part-beg)
+              (forward-line -1)
+              (beginning-of-line)
+              (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 part-beg part-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)))))
            ; 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))
+  mime-message)

 
 (defun notmuch-show-markup-parts-region (beg end depth)
   (save-excursion
     (goto-char beg)
 
 (defun notmuch-show-markup-parts-region (beg end depth)
   (save-excursion
     (goto-char beg)

-    (while (< (point) end)
-      (notmuch-show-markup-part beg end depth))))
+    (let (mime-message)
+      (while (< (point) end)
+        (setq mime-message
+              (notmuch-show-markup-part
+               beg end depth mime-message))))))

 
 (defun notmuch-show-markup-body (depth btn)
   (re-search-forward notmuch-show-body-begin-regexp)
 
 (defun notmuch-show-markup-body (depth btn)
   (re-search-forward notmuch-show-body-begin-regexp)


@@ -603,6 +681,32 @@ which this thread was originally shown."
       (set-marker beg nil)
       (set-marker end nil)
       )))
       (set-marker beg nil)
       (set-marker end nil)
       )))

+(defun notmuch-fontify-headers ()
+  (progn
+    (if (looking-at "[Tt]o:")
+       (progn
+         (overlay-put (make-overlay (point) (re-search-forward ":"))
+                       'face 'message-header-name)
+          (overlay-put (make-overlay (point) (re-search-forward ".*$"))
+                       'face 'message-header-to))
+    (if (looking-at "[B]?[Cc][Cc]:")
+       (progn
+         (overlay-put (make-overlay (point) (re-search-forward ":"))
+                       'face 'message-header-name)
+          (overlay-put (make-overlay (point) (re-search-forward ".*$"))
+                       'face 'message-header-cc))
+    (if (looking-at "[Ss]ubject:")
+       (progn
+         (overlay-put (make-overlay (point) (re-search-forward ":"))
+                       'face 'message-header-name)
+          (overlay-put (make-overlay (point) (re-search-forward ".*$"))
+                       'face 'message-header-subject))
+    (if (looking-at "[Ff]rom:")
+       (progn
+         (overlay-put (make-overlay (point) (re-search-forward ":"))
+                       'face 'message-header-name)
+          (overlay-put (make-overlay (point) (re-search-forward ".*$"))
+                       'face 'message-header-other))))))))

 
 (defun notmuch-show-markup-header (depth)
   (re-search-forward notmuch-show-header-begin-regexp)
 
 (defun notmuch-show-markup-header (depth)
   (re-search-forward notmuch-show-header-begin-regexp)


@@ -623,8 +727,7 @@ which this thread was originally shown."
         (forward-line)
         (while (looking-at "[A-Za-z][-A-Za-z0-9]*:")
           (beginning-of-line)
         (forward-line)
         (while (looking-at "[A-Za-z][-A-Za-z0-9]*:")
           (beginning-of-line)

-          (overlay-put (make-overlay (point) (re-search-forward ":"))
-                       'face 'bold)
+         (notmuch-fontify-headers)

           (forward-line)
           )
        (indent-rigidly beg end depth)
           (forward-line)
           )
        (indent-rigidly beg end depth)


@@ -801,6 +904,7 @@ thread from that buffer can be show when done with this one)."
     (define-key map [mouse-1] 'notmuch-search-show-thread)
     (define-key map "+" 'notmuch-search-add-tag)
     (define-key map "-" 'notmuch-search-remove-tag)
     (define-key map [mouse-1] 'notmuch-search-show-thread)
     (define-key map "+" 'notmuch-search-add-tag)
     (define-key map "-" 'notmuch-search-remove-tag)

+    (define-key map "*" 'notmuch-search-operate-all)

     (define-key map "<" 'beginning-of-buffer)
     (define-key map ">" 'notmuch-search-goto-last-thread)
     (define-key map "=" 'notmuch-search-refresh-view)
     (define-key map "<" 'beginning-of-buffer)
     (define-key map ">" 'notmuch-search-goto-last-thread)
     (define-key map "=" 'notmuch-search-refresh-view)


@@ -813,7 +917,8 @@ thread from that buffer can be show when done with this one)."
 (fset 'notmuch-search-mode-map notmuch-search-mode-map)
 
 (defvar notmuch-search-query-string)
 (fset 'notmuch-search-mode-map notmuch-search-mode-map)
 
 (defvar notmuch-search-query-string)

-(defvar notmuch-search-oldest-first)
+(defvar notmuch-search-oldest-first t
+  "Show the oldest mail first in the search-mode")

 
 
 (defun notmuch-search-scroll-up ()
 
 
 (defun notmuch-search-scroll-up ()


@@ -933,15 +1038,19 @@ and will also appear in a buffer named \"*Notmuch errors*\"."
        (split-string (buffer-substring beg end))))))
 
 (defun notmuch-search-add-tag (tag)
        (split-string (buffer-substring beg end))))))
 
 (defun notmuch-search-add-tag (tag)

+  "Add a tag to messages in the current thread matching the
+active query."

   (interactive
    (list (notmuch-select-tag-with-completion "Tag to add: ")))
   (interactive
    (list (notmuch-select-tag-with-completion "Tag to add: ")))

-  (notmuch-call-notmuch-process "tag" (concat "+" tag) (notmuch-search-find-thread-id))
+  (notmuch-call-notmuch-process "tag" (concat "+" tag) (notmuch-search-find-thread-id) " and " notmuch-search-query-string)

   (notmuch-search-set-tags (delete-dups (sort (cons tag (notmuch-search-get-tags)) 'string<))))
 
 (defun notmuch-search-remove-tag (tag)
   (notmuch-search-set-tags (delete-dups (sort (cons tag (notmuch-search-get-tags)) 'string<))))
 
 (defun notmuch-search-remove-tag (tag)

+  "Remove a tag from messages in the current thread matching the
+active query."

   (interactive
   (interactive

-   (list (notmuch-select-tag-with-completion "Tag to remove: ")))
-  (notmuch-call-notmuch-process "tag" (concat "-" tag) (notmuch-search-find-thread-id))
+   (list (notmuch-select-tag-with-completion "Tag to remove: " (notmuch-search-find-thread-id))))
+  (notmuch-call-notmuch-process "tag" (concat "-" tag) (notmuch-search-find-thread-id) " and " notmuch-search-query-string)

   (notmuch-search-set-tags (delete tag (notmuch-search-get-tags))))
 
 (defun notmuch-search-archive-thread ()
   (notmuch-search-set-tags (delete tag (notmuch-search-get-tags))))
 
 (defun notmuch-search-archive-thread ()


@@ -1000,6 +1109,29 @@ This function advances point to the next line when finished."
                  (set 'more nil))))))
       (delete-process proc))))
 
                  (set 'more nil))))))
       (delete-process proc))))
 

+(defun notmuch-search-operate-all (action)
+  "Operate on all messages matching the current query.  Any
+number of whitespace separated actions can be given.  Each action
+must have one of the two forms
+
+  +tagname              Add the tag `tagname'
+  -tagname              Remove the tag `tagname'
+
+Each character of the tag name may consist of alphanumeric
+characters as well as `_.+-'.
+"
+  (interactive "sOperation (+add -drop): notmuch tag ")
+  (let ((action-split (split-string action " +")))
+    ;; Perform some validation
+    (let ((words action-split))
+      (when (null words) (error "No operation given"))
+      (while words
+       (unless (string-match-p "^[\+\-][_\+\-\\w]+$" (car words))
+         (error "Action must be of the form `+thistag -that_tag'"))
+       (setq words (cdr words))))
+    (apply 'notmuch-call-notmuch-process "tag"
+          (append action-split (list notmuch-search-query-string) nil))))
+

 (defun notmuch-search (query &optional oldest-first)
   "Run \"notmuch search\" with the given query string and display results."
   (interactive "sNotmuch search: ")
 (defun notmuch-search (query &optional oldest-first)
   "Run \"notmuch search\" with the given query string and display results."
   (interactive "sNotmuch search: ")


@@ -1082,7 +1214,7 @@ current search results AND that are tagged with the given tag."
 (defun notmuch ()
   "Run notmuch to display all mail with tag of 'inbox'"
   (interactive)
 (defun notmuch ()
   "Run notmuch to display all mail with tag of 'inbox'"
   (interactive)

-  (notmuch-search "tag:inbox" t))
+  (notmuch-search "tag:inbox" notmuch-search-oldest-first))

 
 (setq mail-user-agent 'message-user-agent)
 
 
 (setq mail-user-agent 'message-user-agent)
 


@@ -1152,7 +1284,7 @@ results for the search terms in that line.
       (setq folder (notmuch-folder-find-name)))
   (let ((search (assoc folder notmuch-folders)))
     (if search
       (setq folder (notmuch-folder-find-name)))
   (let ((search (assoc folder notmuch-folders)))
     (if search

-       (notmuch-search (cdr search) t))))
+       (notmuch-search (cdr search) notmuch-search-oldest-first))))

 
 (defun notmuch-folder ()
   "Show the notmuch folder view and update the displayed counts."
 
 (defun notmuch-folder ()
   "Show the notmuch folder view and update the displayed counts."