emacs/notmuch-show.el: Part headers are real buttons that save the part

Convert the part headers into buttons that save the part when
activated.
This commit is contained in:
Carl Worth 2010-04-21 13:19:19 -07:00
parent c579c8201f
commit 6157fe0bfd

View file

@ -204,21 +204,40 @@ message at DEPTH in the current thread."
(narrow-to-region start (point-max)) (narrow-to-region start (point-max))
(run-hooks 'notmuch-show-markup-headers-hook))))) (run-hooks 'notmuch-show-markup-headers-hook)))))
(defun notmuch-show-insert-part-header (content-type declared-type &optional name) (define-button-type 'notmuch-show-part-button-type
(let ((start (point))) 'action 'notmuch-show-part-button-action
;; XXX dme: Make this a more useful button (save the part, display 'follow-link t
;; external, etc.) 'face 'message-mml)
(insert "[ "
(if name (concat name ": ") "") (defun notmuch-show-insert-part-header (nth content-type declared-type &optional name)
declared-type (insert-button
(if (not (string-equal declared-type content-type)) (concat "[ "
(concat " (as " content-type ")") (if name (concat name ": ") "")
"") declared-type
" ]\n") (if (not (string-equal declared-type content-type))
(overlay-put (make-overlay start (point)) 'face 'bold))) (concat " (as " content-type ")")
"")
" ]\n")
:type 'notmuch-show-part-button-type
:notmuch-part nth
:notmuch-filename name))
;; Functions handling particular MIME parts. ;; Functions handling particular MIME parts.
(defun notmuch-show-save-part (message-id nth &optional filename)
(with-temp-buffer
;; Always acquires the part via `notmuch part', even if it is
;; available in the JSON output.
(insert (notmuch-show-get-bodypart-internal message-id nth))
(let ((file (read-file-name
"Filename to save as: "
(or mailcap-download-directory "~/")
nil nil
filename))
(require-final-newline nil)
(coding-system-for-write 'no-conversion))
(write-region (point-min) (point-max) file))))
(defun notmuch-show-mm-display-part-inline (msg part content-type content) (defun notmuch-show-mm-display-part-inline (msg part content-type content)
"Use the mm-decode/mm-view functions to display a part in the "Use the mm-decode/mm-view functions to display a part in the
current buffer, if possible." current buffer, if possible."
@ -239,7 +258,7 @@ current buffer, if possible."
;; If this text/plain part is not the first part in the message, ;; If this text/plain part is not the first part in the message,
;; insert a header to make this clear. ;; insert a header to make this clear.
(if (> nth 1) (if (> nth 1)
(notmuch-show-insert-part-header declared-type content-type (plist-get part :filename))) (notmuch-show-insert-part-header nth declared-type content-type (plist-get part :filename)))
(insert (notmuch-show-get-bodypart-content msg part nth)) (insert (notmuch-show-get-bodypart-content msg part nth))
(save-excursion (save-excursion
(save-restriction (save-restriction
@ -265,7 +284,7 @@ current buffer, if possible."
(defun notmuch-show-insert-part-*/* (msg part content-type nth depth declared-type) (defun notmuch-show-insert-part-*/* (msg part content-type nth depth declared-type)
;; This handler _must_ succeed - it is the handler of last resort. ;; This handler _must_ succeed - it is the handler of last resort.
(notmuch-show-insert-part-header content-type declared-type (plist-get part :filename)) (notmuch-show-insert-part-header nth content-type declared-type (plist-get part :filename))
(let ((content (notmuch-show-get-bodypart-content msg part nth))) (let ((content (notmuch-show-get-bodypart-content msg part nth)))
(if content (if content
(notmuch-show-mm-display-part-inline msg part content-type content))) (notmuch-show-mm-display-part-inline msg part content-type content)))
@ -969,6 +988,15 @@ buffer."
(interactive) (interactive)
(notmuch-show-do-stash (notmuch-show-get-to))) (notmuch-show-do-stash (notmuch-show-get-to)))
;; Commands typically bound to buttons.
(defun notmuch-show-part-button-action (button)
(let ((nth (button-get button :notmuch-part)))
(if nth
(notmuch-show-save-part (notmuch-show-get-message-id) nth
(button-get button :notmuch-filename))
(message "Not a valid part (is it a fake part?)."))))
;; ;;
(provide 'notmuch-show) (provide 'notmuch-show)