]> git.notmuchmail.org Git - notmuch/blobdiff - emacs/notmuch-show.el
emacs: Allow the user to choose the "From" address when composing a new message
[notmuch] / emacs / notmuch-show.el
index 3d8431a6e90f5f04b571ba5e8ce7bbe6f608d39e..93c5e53b2d235e0ead9b321011149183422216d1 100644 (file)
@@ -64,6 +64,17 @@ any given message."
   :group 'notmuch
   :type 'boolean)
 
+(defcustom notmuch-show-elide-same-subject nil
+  "Do not show the subject of a collapsed message if it is the
+same as that of the previous message."
+  :group 'notmuch
+  :type 'boolean)
+
+(defcustom notmuch-show-always-show-subject t
+  "Should a collapsed message show the `Subject:' line?"
+  :group 'notmuch
+  :type 'boolean)
+
 (defvar notmuch-show-markup-headers-hook '(notmuch-show-colour-headers)
   "A list of functions called to decorate the headers listed in
 `notmuch-message-headers'.")
@@ -211,12 +222,30 @@ any given message."
                                             'face 'notmuch-tag-face)
                                 ")"))))))
 
+(defun notmuch-show-clean-address (address)
+  "Clean a single email address for display."
+  (let* ((parsed (mail-header-parse-address address))
+        (address (car parsed))
+        (name (cdr parsed)))
+    ;; Remove double quotes. They might be required during transport,
+    ;; but we don't need to see them.
+    (when name
+      (setq name (replace-regexp-in-string "\"" "" name)))
+    ;; If the address is 'foo@bar.com <foo@bar.com>' then show just
+    ;; 'foo@bar.com'.
+    (when (string= name address)
+      (setq name nil))
+
+    (if (not name)
+       address
+      (concat name " <" address ">"))))
+
 (defun notmuch-show-insert-headerline (headers date tags depth)
   "Insert a notmuch style headerline based on HEADERS for a
 message at DEPTH in the current thread."
   (let ((start (point)))
     (insert (notmuch-show-spaces-n depth)
-           (plist-get headers :From)
+           (notmuch-show-clean-address (plist-get headers :From))
            " ("
            date
            ") ("
@@ -335,6 +364,85 @@ current buffer, if possible."
       (indent-rigidly start (point) 1)))
   t)
 
+(defun notmuch-show-setup-w3m ()
+  "Instruct w3m how to retrieve content from a \"related\" part of a message."
+  (interactive)
+  (if (boundp 'w3m-cid-retrieve-function-alist)
+    (unless (assq 'notmuch-show-mode w3m-cid-retrieve-function-alist)
+      (push (cons 'notmuch-show-mode 'notmuch-show-w3m-cid-retrieve)
+           w3m-cid-retrieve-function-alist)))
+  (setq mm-inline-text-html-with-images t))
+
+(defvar w3m-current-buffer) ;; From `w3m.el'.
+(defvar notmuch-show-w3m-cid-store nil)
+(make-variable-buffer-local 'notmuch-show-w3m-cid-store)
+
+(defun notmuch-show-w3m-cid-store-internal (content-id
+                                           message-id
+                                           part-number
+                                           content-type
+                                           content)
+  (push (list content-id
+             message-id
+             part-number
+             content-type
+             content)
+       notmuch-show-w3m-cid-store))
+
+(defun notmuch-show-w3m-cid-store (msg part)
+  (let ((content-id (plist-get part :content-id)))
+    (when content-id
+      (notmuch-show-w3m-cid-store-internal (concat "cid:" content-id)
+                                          (plist-get msg :id)
+                                          (plist-get part :id)
+                                          (plist-get part :content-type)
+                                          nil))))
+
+(defun notmuch-show-w3m-cid-retrieve (url &rest args)
+  (let ((matching-part (with-current-buffer w3m-current-buffer
+                        (assoc url notmuch-show-w3m-cid-store))))
+    (if matching-part
+       (let ((message-id (nth 1 matching-part))
+             (part-number (nth 2 matching-part))
+             (content-type (nth 3 matching-part))
+             (content (nth 4 matching-part)))
+         ;; If we don't already have the content, get it and cache
+         ;; it, as some messages reference the same cid: part many
+         ;; times (hundreds!), which results in many calls to
+         ;; `notmuch part'.
+         (unless content
+           (setq content (notmuch-show-get-bodypart-internal (concat "id:" message-id)
+                                                             part-number))
+           (with-current-buffer w3m-current-buffer
+             (notmuch-show-w3m-cid-store-internal url
+                                                  message-id
+                                                  part-number
+                                                  content-type
+                                                  content)))
+         (insert content)
+         content-type)
+      nil)))
+
+(defun notmuch-show-insert-part-multipart/related (msg part content-type nth depth declared-type)
+  (notmuch-show-insert-part-header nth declared-type content-type nil)
+  (let ((inner-parts (plist-get part :content))
+       (start (point)))
+
+    ;; We assume that the first part is text/html and the remainder
+    ;; things that it references.
+
+    ;; Stash the non-primary parts.
+    (mapc (lambda (part)
+           (notmuch-show-w3m-cid-store msg part))
+         (cdr inner-parts))
+
+    ;; Render the primary part.
+    (notmuch-show-insert-bodypart msg (car inner-parts) depth)
+
+    (when notmuch-show-indent-multipart
+      (indent-rigidly start (point) 1)))
+  t)
+
 (defun notmuch-show-insert-part-multipart/* (msg part content-type nth depth declared-type)
   (notmuch-show-insert-part-header nth declared-type content-type nil)
   (let ((inner-parts (plist-get part :content))
@@ -448,7 +556,7 @@ current buffer, if possible."
   (with-temp-buffer
     (let ((coding-system-for-read 'no-conversion))
       (call-process notmuch-command nil t nil
-                   "part" (format "--part=%s" part-number) message-id)
+                   "show" "--format=raw" (format "--part=%s" part-number) message-id)
       (buffer-string))))
 
 (defun notmuch-show-get-bodypart-content (msg part nth)
@@ -542,8 +650,9 @@ current buffer, if possible."
       ;; 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))
+      (when (and notmuch-show-elide-same-subject
+                (not (string= notmuch-show-previous-subject
+                              bare-subject)))
        (forward-line 1))
       (setq headers-start (point-marker)))
     (setq headers-end (point-marker))
@@ -683,7 +792,7 @@ function is used. "
        (define-key map (kbd "<backtab>") 'notmuch-show-previous-button)
        (define-key map (kbd "TAB") 'notmuch-show-next-button)
        (define-key map "s" 'notmuch-search)
-       (define-key map "m" 'notmuch-mua-mail)
+       (define-key map "m" 'notmuch-mua-new-mail)
        (define-key map "f" 'notmuch-show-forward-message)
        (define-key map "r" 'notmuch-show-reply)
        (define-key map "|" 'notmuch-show-pipe-message)
@@ -1109,10 +1218,8 @@ the result."
         (new-tags (notmuch-show-add-tags-worker current-tags toadd)))
 
     (unless (equal current-tags new-tags)
-      (apply 'notmuch-call-notmuch-process
-            (append (cons "tag"
-                          (mapcar (lambda (s) (concat "+" s)) toadd))
-                    (cons (notmuch-show-get-message-id) nil)))
+      (apply 'notmuch-tag (notmuch-show-get-message-id)
+            (mapcar (lambda (s) (concat "+" s)) toadd))
       (notmuch-show-set-tags new-tags))))
 
 (defun notmuch-show-remove-tag (&rest toremove)
@@ -1125,10 +1232,8 @@ the result."
         (new-tags (notmuch-show-del-tags-worker current-tags toremove)))
 
     (unless (equal current-tags new-tags)
-      (apply 'notmuch-call-notmuch-process
-            (append (cons "tag"
-                          (mapcar (lambda (s) (concat "-" s)) toremove))
-                    (cons (notmuch-show-get-message-id) nil)))
+      (apply 'notmuch-tag (notmuch-show-get-message-id)
+            (mapcar (lambda (s) (concat "-" s)) toremove))
       (notmuch-show-set-tags new-tags))))
 
 (defun notmuch-show-toggle-headers ()