]> git.notmuchmail.org Git - notmuch/blobdiff - emacs/notmuch-show.el
emacs: add more part handling functions
[notmuch] / emacs / notmuch-show.el
index 3daa8685a46f3df1f283acba947dc819c8e69a0b..e08497d98b089486efd792c702182c2808d984dc 100644 (file)
@@ -280,6 +280,48 @@ current buffer, if possible."
              t)
          nil)))))
 
+(defun notmuch-show-insert-part-multipart/alternative (msg part content-type nth depth declared-type)
+  (let ((inner-parts (plist-get part :content)))
+    (notmuch-show-insert-part-header nth declared-type content-type nil)
+    ;; In most cases, multipart/alternative is used to provide both
+    ;; text/plain and text/html (or multipart/related with text/html
+    ;; and image/*) parts. We might allow the user to express a
+    ;; preference about which part to show, but for the moment we just
+    ;; choose the first. This is usually the text/plain part.
+    (notmuch-show-insert-bodypart msg (car inner-parts) depth)
+    (mapc (lambda (inner-part)
+           (let ((inner-type (concat (plist-get inner-part :content-type) " (not shown)")))
+             (notmuch-show-insert-part-header (plist-get inner-part :id) inner-type inner-type nil)))
+         (cdr inner-parts)))
+  t)
+
+(defun notmuch-show-insert-part-multipart/* (msg part content-type nth depth declared-type)
+  (let ((inner-parts (plist-get part :content)))
+    (notmuch-show-insert-part-header nth declared-type content-type nil)
+    ;; Show all of the parts.
+    (mapc (lambda (inner-part)
+           (notmuch-show-insert-bodypart msg inner-part depth))
+         inner-parts))
+  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)
+    ;; 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)))
+    ;; 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))
+  t)
+
 (defun notmuch-show-insert-part-text/plain (msg part content-type nth depth declared-type)
   (let ((start (point)))
     ;; If this text/plain part is not the first part in the message,
@@ -381,17 +423,24 @@ current buffer, if possible."
 (defun notmuch-show-make-symbol (type)
   (make-symbol (concat "notmuch-show-" type)))
 
+(defun notmuch-show-strip-re (string)
+  (replace-regexp-in-string "\\([Rr]e: *\\)+" "" string))
+
+(defvar notmuch-show-previous-subject "")
+(make-variable-buffer-local 'notmuch-show-previous-subject)
+
 (defun notmuch-show-insert-msg (msg depth)
   "Insert the message MSG at depth DEPTH in the current thread."
-  (let ((headers (plist-get msg :headers))
-       ;; Indentation causes the buffer offset of the start/end
-       ;; points to move, so we must use markers.
-       message-start message-end
-       content-start content-end
-       headers-start headers-end
-       body-start body-end
-       (headers-invis-spec (notmuch-show-make-symbol "header"))
-       (message-invis-spec (notmuch-show-make-symbol "message")))
+  (let* ((headers (plist-get msg :headers))
+        ;; Indentation causes the buffer offset of the start/end
+        ;; points to move, so we must use markers.
+        message-start message-end
+        content-start content-end
+        headers-start headers-end
+        body-start body-end
+        (headers-invis-spec (notmuch-show-make-symbol "header"))
+        (message-invis-spec (notmuch-show-make-symbol "message"))
+        (bare-subject (notmuch-show-strip-re (plist-get headers :Subject))))
 
     ;; Set `buffer-invisibility-spec' to `nil' (a list), otherwise
     ;; removing items from `buffer-invisibility-spec' (which is what
@@ -428,10 +477,17 @@ current buffer, if possible."
     (insert "\n")
     (save-excursion
       (goto-char content-start)
-      (forward-line 1)
+      ;; If the subject of this message is the same as that of the
+      ;; previous message, don't display it when this message is
+      ;; collapsed.
+      (when (not (string= notmuch-show-previous-subject
+                         bare-subject))
+       (forward-line 1))
       (setq headers-start (point-marker)))
     (setq headers-end (point-marker))
 
+    (setq notmuch-show-previous-subject bare-subject)
+
     (setq body-start (point-marker))
     (notmuch-show-insert-body msg (plist-get msg :body) depth)
     ;; Ensure that the body ends with a newline.
@@ -536,6 +592,10 @@ function is used. "
     ;; Move straight to the first open message
     (if (not (notmuch-show-message-visible-p))
        (notmuch-show-next-open-message))
+
+    ;; Set the header line to the subject of the first open message.
+    (setq header-line-format (notmuch-show-strip-re (notmuch-show-get-subject)))
+
     (notmuch-show-mark-read)))
 
 (defvar notmuch-show-stash-map
@@ -555,7 +615,7 @@ function is used. "
 (defvar notmuch-show-mode-map
       (let ((map (make-sparse-keymap)))
        (define-key map "?" 'notmuch-help)
-       (define-key map "q" 'kill-this-buffer)
+       (define-key map "q" 'notmuch-kill-this-buffer)
        (define-key map (kbd "<C-tab>") 'widget-backward)
        (define-key map (kbd "M-TAB") 'notmuch-show-previous-button)
        (define-key map (kbd "<backtab>") 'notmuch-show-previous-button)
@@ -917,18 +977,20 @@ any effects from previous calls to
 (defun notmuch-show-view-raw-message ()
   "View the file holding the current message."
   (interactive)
-  (let ((id (notmuch-show-get-message-id)))
-    (let ((buf (get-buffer-create (concat "*notmuch-raw-" id "*"))))
-      (switch-to-buffer buf)
-      (save-excursion
-       (call-process notmuch-command nil t nil "show" "--format=raw" id)))))
+  (let* ((id (notmuch-show-get-message-id))
+        (buf (get-buffer-create (concat "*notmuch-raw-" id "*"))))
+    (call-process notmuch-command nil buf nil "show" "--format=raw" id)
+    (switch-to-buffer buf)
+    (goto-char (point-min))
+    (set-buffer-modified-p nil)
+    (view-buffer buf 'kill-buffer-if-not-modified)))
 
 (defun notmuch-show-pipe-message (entire-thread command)
   "Pipe the contents of the current message (or thread) to the given command.
 
 The given command will be executed with the raw contents of the
 current email message as stdin. Anything printed by the command
-to stdout or stderr will appear in the *Messages* buffer.
+to stdout or stderr will appear in the *notmuch-pipe* buffer.
 
 When invoked with a prefix argument, the command will receive all
 open messages in the current thread (formatted as an mbox) rather
@@ -937,13 +999,25 @@ than only the current message."
   (let (shell-command)
     (if entire-thread
        (setq shell-command 
-             (concat "notmuch show --format=mbox "
+             (concat notmuch-command " show --format=mbox "
                      (shell-quote-argument
                       (mapconcat 'identity (notmuch-show-get-message-ids-for-open-messages) " OR "))
                      " | " command))
       (setq shell-command
-           (concat "notmuch show --format=raw " (shell-quote-argument (notmuch-show-get-message-id)) " | " command)))
-    (start-process-shell-command "notmuch-pipe-command" "*notmuch-pipe*" shell-command)))
+           (concat notmuch-command " show --format=raw "
+                   (shell-quote-argument (notmuch-show-get-message-id)) " | " command)))
+    (let ((buf (get-buffer-create (concat "*notmuch-pipe*"))))
+      (with-current-buffer buf
+       (setq buffer-read-only nil)
+       (erase-buffer)
+       (let ((exit-code (call-process-shell-command shell-command nil buf)))
+         (goto-char (point-max))
+         (set-buffer-modified-p nil)
+         (setq buffer-read-only t)
+         (unless (zerop exit-code)
+           (switch-to-buffer-other-window buf)
+           (message (format "Command '%s' exited abnormally with code %d"
+                            shell-command exit-code))))))))
 
 (defun notmuch-show-add-tags-worker (current-tags add-tags)
   "Add to `current-tags' with any tags from `add-tags' not
@@ -1042,7 +1116,7 @@ argument, hide all of the messages."
        until (not (notmuch-show-goto-message-next)))
   ;; Move to the next item in the search results, if any.
   (let ((parent-buffer notmuch-show-parent-buffer))
-    (kill-this-buffer)
+    (notmuch-kill-this-buffer)
     (if parent-buffer
        (progn
          (switch-to-buffer parent-buffer)
@@ -1069,49 +1143,45 @@ buffer."
   (interactive)
   (notmuch-show-archive-thread-internal nil))
 
-(defun notmuch-show-do-stash (text)
-  (kill-new text)
-  (message "Saved: %s" text))
-
 (defun notmuch-show-stash-cc ()
   "Copy CC field of current message to kill-ring."
   (interactive)
-  (notmuch-show-do-stash (notmuch-show-get-cc)))
+  (notmuch-common-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)))
+  (notmuch-common-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)))
+  (notmuch-common-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)))
+  (notmuch-common-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)))
+  (notmuch-common-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)))
+  (notmuch-common-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) ",")))
+  (notmuch-common-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)))
+  (notmuch-common-do-stash (notmuch-show-get-to)))
 
 ;; Commands typically bound to buttons.