]> git.notmuchmail.org Git - notmuch/blobdiff - emacs/notmuch-show.el
Merge branch 'release'
[notmuch] / emacs / notmuch-show.el
index b70dbfb2b95c4f07a774e8632592ef0daa5a71b6..2806879e53cfff412e07c4b175478f8ed728998e 100644 (file)
@@ -75,7 +75,10 @@ any given message."
   :group 'notmuch
   :type 'hook)
 
-(defcustom notmuch-show-insert-text/plain-hook '(notmuch-wash-excerpt-citations)
+(defcustom notmuch-show-insert-text/plain-hook '(notmuch-wash-wrap-long-lines
+                                                notmuch-wash-tidy-citations
+                                                notmuch-wash-elide-blank-lines
+                                                notmuch-wash-excerpt-citations)
   "Functions used to improve the display of text/plain parts."
   :group 'notmuch
   :type 'hook
@@ -91,6 +94,16 @@ any given message."
   :group 'notmuch
   :type 'boolean)
 
+(defcustom notmuch-show-indent-messages-width 1
+  "Width of message indentation in threads.
+
+Messages are shown indented according to their depth in a thread.
+This variable determines the width of this indentation measured
+in number of blanks.  Defaults to `1', choose `0' to disable
+indentation."
+  :group 'notmuch
+  :type 'integer)
+
 (defcustom notmuch-show-indent-multipart nil
   "Should the sub-parts of a multipart/* part be indented?"
   ;; dme: Not sure which is a good default.
@@ -238,7 +251,7 @@ unchanged ADDRESS if parsing fails."
   "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)
+    (insert (notmuch-show-spaces-n (* notmuch-show-indent-messages-width depth))
            (notmuch-show-clean-address (plist-get headers :From))
            " ("
            date
@@ -255,12 +268,12 @@ message at DEPTH in the current thread."
 (defun notmuch-show-insert-headers (headers)
   "Insert the headers of the current message."
   (let ((start (point)))
-    (mapc '(lambda (header)
-            (let* ((header-symbol (intern (concat ":" header)))
-                   (header-value (plist-get headers header-symbol)))
-              (if (and header-value
-                       (not (string-equal "" header-value)))
-                  (notmuch-show-insert-header header header-value))))
+    (mapc (lambda (header)
+           (let* ((header-symbol (intern (concat ":" header)))
+                  (header-value (plist-get headers header-symbol)))
+             (if (and header-value
+                      (not (string-equal "" header-value)))
+                 (notmuch-show-insert-header header header-value))))
          notmuch-message-headers)
     (save-excursion
       (save-restriction
@@ -310,17 +323,17 @@ message at DEPTH in the current thread."
        ;; ange-ftp, which is reasonable to use here.
        (mm-write-region (point-min) (point-max) file nil nil nil 'no-conversion t)))))
 
-(defun notmuch-show-mm-display-part-inline (msg part content-type content)
+(defun notmuch-show-mm-display-part-inline (msg part nth content-type)
   "Use the mm-decode/mm-view functions to display a part in the
 current buffer, if possible."
   (let ((display-buffer (current-buffer)))
     (with-temp-buffer
-      (insert content)
       (let ((handle (mm-make-handle (current-buffer) (list content-type))))
-       (set-buffer display-buffer)
        (if (and (mm-inlinable-p handle)
                 (mm-inlined-p handle))
-           (progn
+           (let ((content (notmuch-show-get-bodypart-content msg part nth)))
+             (insert content)
+             (set-buffer display-buffer)
              (mm-display-part handle)
              t)
          nil)))))
@@ -334,7 +347,7 @@ current buffer, if possible."
     ))
 
 (defun notmuch-show-multipart/*-to-list (part)
-  (mapcar '(lambda (inner-part) (plist-get inner-part :content-type))
+  (mapcar (lambda (inner-part) (plist-get inner-part :content-type))
          (plist-get part :content)))
 
 (defun notmuch-show-multipart/alternative-choose (types)
@@ -447,11 +460,10 @@ current buffer, if possible."
 
 (defun notmuch-show-insert-part-multipart/signed (msg part content-type nth depth declared-type)
   (let ((button (notmuch-show-insert-part-header nth declared-type content-type nil)))
-    (button-put button 'face '(:foreground "blue"))
+    (button-put button 'face 'notmuch-crypto-part-header)
     ;; add signature status button if sigstatus provided
     (if (plist-member part :sigstatus)
-       (let* ((headers (plist-get msg :headers))
-              (from (plist-get headers :From))
+       (let* ((from (notmuch-show-get-header :From msg))
               (sigstatus (car (plist-get part :sigstatus))))
          (notmuch-crypto-insert-sigstatus-button sigstatus from))
       ;; if we're not adding sigstatus, tell the user how they can get it
@@ -470,15 +482,14 @@ current buffer, if possible."
 
 (defun notmuch-show-insert-part-multipart/encrypted (msg part content-type nth depth declared-type)
   (let ((button (notmuch-show-insert-part-header nth declared-type content-type nil)))
-    (button-put button 'face '(:foreground "blue"))
+    (button-put button 'face 'notmuch-crypto-part-header)
     ;; add encryption status button if encstatus specified
     (if (plist-member part :encstatus)
        (let ((encstatus (car (plist-get part :encstatus))))
          (notmuch-crypto-insert-encstatus-button encstatus)
          ;; add signature status button if sigstatus specified
          (if (plist-member part :sigstatus)
-             (let* ((headers (plist-get msg :headers))
-                    (from (plist-get headers :From))
+             (let* ((from (notmuch-show-get-header :From msg))
                     (sigstatus (car (plist-get part :sigstatus))))
                (notmuch-crypto-insert-sigstatus-button sigstatus from))))
       ;; if we're not adding encstatus, tell the user how they can get it
@@ -511,7 +522,6 @@ current buffer, if possible."
 (defun notmuch-show-insert-part-message/rfc822 (msg part content-type nth depth declared-type)
   (notmuch-show-insert-part-header nth declared-type content-type nil)
   (let* ((message (car (plist-get part :content)))
-        (headers (plist-get message :headers))
         (body (car (plist-get message :body)))
         (start (point)))
 
@@ -578,17 +588,14 @@ current buffer, if possible."
                nil))
          nil))))
 
-(defun notmuch-show-insert-part-application/* (msg part content-type nth depth declared-type
-)
-  ;; do not render random "application" parts
-  (notmuch-show-insert-part-header nth content-type declared-type (plist-get part :filename)))
+;; Handler for wash generated inline patch fake parts.
+(defun notmuch-show-insert-part-inline-patch-fake-part (msg part content-type nth depth declared-type)
+  (notmuch-show-insert-part-*/* msg part "text/x-diff" nth depth "inline patch"))
 
 (defun notmuch-show-insert-part-*/* (msg part content-type nth depth declared-type)
   ;; This handler _must_ succeed - it is the handler of last resort.
   (notmuch-show-insert-part-header nth content-type declared-type (plist-get part :filename))
-  (let ((content (notmuch-show-get-bodypart-content msg part nth)))
-    (if content
-       (notmuch-show-mm-display-part-inline msg part content-type content)))
+  (notmuch-show-mm-display-part-inline msg part nth content-type)
   t)
 
 ;; Functions for determining how to handle MIME parts.
@@ -657,7 +664,7 @@ current buffer, if possible."
 
 (defun notmuch-show-insert-body (msg body depth)
   "Insert the body BODY at depth DEPTH in the current thread."
-  (mapc '(lambda (part) (notmuch-show-insert-bodypart msg part depth)) body))
+  (mapc (lambda (part) (notmuch-show-insert-bodypart msg part depth)) body))
 
 (defun notmuch-show-make-symbol (type)
   (make-symbol (concat "notmuch-show-" type)))
@@ -739,7 +746,7 @@ current buffer, if possible."
     (setq content-end (point-marker))
 
     ;; Indent according to the depth in the thread.
-    (indent-rigidly content-start content-end depth)
+    (indent-rigidly content-start content-end (* notmuch-show-indent-messages-width depth))
 
     (setq message-end (point-max-marker))
 
@@ -775,11 +782,11 @@ current buffer, if possible."
 
 (defun notmuch-show-insert-thread (thread depth)
   "Insert the thread THREAD at depth DEPTH in the current forest."
-  (mapc '(lambda (tree) (notmuch-show-insert-tree tree depth)) thread))
+  (mapc (lambda (tree) (notmuch-show-insert-tree tree depth)) thread))
 
 (defun notmuch-show-insert-forest (forest)
   "Insert the forest of threads FOREST."
-  (mapc '(lambda (thread) (notmuch-show-insert-thread thread 0)) forest))
+  (mapc (lambda (thread) (notmuch-show-insert-thread thread 0)) forest))
 
 (defvar notmuch-show-thread-id nil)
 (make-variable-buffer-local 'notmuch-show-thread-id)
@@ -803,7 +810,7 @@ a corresponding notmuch search."
       (remove-overlays (match-beginning 0) (match-end 0) 'goto-address t)
       (make-text-button (match-beginning 0) (match-end 0)
                        'action `(lambda (arg)
-                                  (notmuch-search ,(match-string-no-properties 0)))
+                                  (notmuch-show ,(match-string-no-properties 0)))
                        'follow-link t
                        'help-echo "Mouse-1, RET: search for this message"
                        'face goto-address-mail-face))))
@@ -824,18 +831,27 @@ non-nil.
 The optional BUFFER-NAME provides the name of the buffer in
 which the message thread is shown. If it is nil (which occurs
 when the command is called interactively) the argument to the
-function is used. "
+function is used.
+
+The optional CRYPTO-SWITCH toggles the value of the
+notmuch-crypto-process-mime customization variable for this show
+buffer."
   (interactive "sNotmuch show: ")
+  (let* ((process-crypto (if crypto-switch
+                            (not notmuch-crypto-process-mime)
+                          notmuch-crypto-process-mime)))
+    (notmuch-show-worker thread-id parent-buffer query-context buffer-name process-crypto)))
+
+(defun notmuch-show-worker (thread-id parent-buffer query-context buffer-name process-crypto)
   (let* ((buffer-name (generate-new-buffer-name
                       (or buffer-name
                           (concat "*notmuch-" thread-id "*"))))
         (buffer (get-buffer-create buffer-name))
-        (process-crypto (if crypto-switch
-                            (not notmuch-crypto-process-mime)
-                          notmuch-crypto-process-mime))
         (inhibit-read-only t))
     (switch-to-buffer buffer)
     (notmuch-show-mode)
+    ;; Don't track undo information for this buffer
+    (set 'buffer-undo-list t)
 
     (setq notmuch-show-thread-id thread-id)
     (setq notmuch-show-parent-buffer parent-buffer)
@@ -878,16 +894,17 @@ function is used. "
   "Refresh the current view (with crypto switch if prefix given).
 
 Kills the current buffer and reruns notmuch show with the same
-thread id.  If a prefix is given, the current thread is
-redisplayed with the crypto switch activated, which switch the
-logic of the notmuch-crypto-process-mime customization variable."
+thread id.  If a prefix is given, crypto processing is toggled."
   (interactive "P")
   (let ((thread-id notmuch-show-thread-id)
        (parent-buffer notmuch-show-parent-buffer)
        (query-context notmuch-show-query-context)
-       (buffer-name notmuch-show-buffer-name))
+       (buffer-name notmuch-show-buffer-name)
+       (process-crypto (if crypto-switch
+                           (not notmuch-show-process-crypto)
+                         notmuch-show-process-crypto)))
     (notmuch-kill-this-buffer)
-    (notmuch-show thread-id parent-buffer query-context buffer-name crypto-switch)))
+    (notmuch-show-worker thread-id parent-buffer query-context buffer-name process-crypto)))
 
 (defvar notmuch-show-stash-map
   (let ((map (make-sparse-keymap)))
@@ -896,6 +913,7 @@ logic of the notmuch-crypto-process-mime customization variable."
     (define-key map "F" 'notmuch-show-stash-filename)
     (define-key map "f" 'notmuch-show-stash-from)
     (define-key map "i" 'notmuch-show-stash-message-id)
+    (define-key map "I" 'notmuch-show-stash-message-id-stripped)
     (define-key map "s" 'notmuch-show-stash-subject)
     (define-key map "T" 'notmuch-show-stash-tags)
     (define-key map "t" 'notmuch-show-stash-to)
@@ -1016,14 +1034,6 @@ All currently available key bindings:
     (notmuch-show-move-to-message-top)
     t))
 
-(defun notmuch-show-move-past-invisible-forward ()
-  (while (point-invisible-p)
-    (forward-char)))
-
-(defun notmuch-show-move-past-invisible-backward ()
-  (while (point-invisible-p)
-    (backward-char)))
-
 ;; Functions relating to the visibility of messages and their
 ;; components.
 
@@ -1050,6 +1060,12 @@ All currently available key bindings:
     (put-text-property (point) (+ (point) 1) :notmuch-message-properties props)))
 
 (defun notmuch-show-get-message-properties ()
+  "Return the properties of the current message as a plist.
+
+Some useful entries are:
+:headers - Property list containing the headers :Date, :Subject, :From, etc.
+:body - Body of the message
+:tags - Tags for this message"
   (save-excursion
     (notmuch-show-move-to-message-top)
     (get-text-property (point) :notmuch-message-properties)))
@@ -1076,9 +1092,9 @@ All currently available key bindings:
   "Return the filename of the current message."
   (notmuch-show-get-prop :filename))
 
-(defun notmuch-show-get-header (header)
+(defun notmuch-show-get-header (header &optional props)
   "Return the named header of the current message, if any."
-  (plist-get (notmuch-show-get-prop :headers) header))
+  (plist-get (notmuch-show-get-prop :headers props) header))
 
 (defun notmuch-show-get-cc ()
   (notmuch-show-get-header :Cc))
@@ -1134,30 +1150,23 @@ All currently available key bindings:
 
 ;; Commands typically bound to keys.
 
-(defun notmuch-show-advance-and-archive ()
-  "Advance through thread and archive.
-
-This command is intended to be one of the simplest ways to
-process a thread of email. It does the following:
+(defun notmuch-show-advance ()
+  "Advance through thread.
 
 If the current message in the thread is not yet fully visible,
 scroll by a near screenful to read more of the message.
 
 Otherwise, (the end of the current message is already within the
-current window), advance to the next open message.
-
-Finally, if there is no further message to advance to, and this
-last message is already read, then archive the entire current
-thread, (remove the \"inbox\" tag from each message). Also kill
-this buffer, and display the next thread from the search from
-which this thread was originally shown."
+current window), advance to the next open message."
   (interactive)
   (let* ((end-of-this-message (notmuch-show-message-bottom))
-        (visible-end-of-this-message (1- end-of-this-message)))
+        (visible-end-of-this-message (1- end-of-this-message))
+        (ret nil))
     (while (invisible-p visible-end-of-this-message)
       (setq visible-end-of-this-message
-           (previous-single-char-property-change visible-end-of-this-message
-                                                 'invisible)))
+           (max (point-min)
+                (1- (previous-single-char-property-change
+                     visible-end-of-this-message 'invisible)))))
     (cond
      ;; Ideally we would test `end-of-this-message' against the result
      ;; of `window-end', but that doesn't account for the fact that
@@ -1172,8 +1181,24 @@ which this thread was originally shown."
       (notmuch-show-next-open-message))
 
      (t
-      ;; This is the last message - archive the thread.
-      (notmuch-show-archive-thread)))))
+      ;; This is the last message - change the return value
+      (setq ret t)))
+    ret))
+
+(defun notmuch-show-advance-and-archive ()
+  "Advance through thread and archive.
+
+This command is intended to be one of the simplest ways to
+process a thread of email. It works exactly like
+notmuch-show-advance, in that it scrolls through messages in a
+show buffer, except that when it gets to the end of the buffer it
+archives the entire current thread, (remove the \"inbox\" tag
+from each message), kills the buffer, and displays the next
+thread from the search from which this thread was originally
+shown."
+  (interactive)
+  (if (notmuch-show-advance)
+      (notmuch-show-archive-thread)))
 
 (defun notmuch-show-rewind ()
   "Backup through the thread, (reverse scrolling compared to \\[notmuch-show-advance-and-archive]).
@@ -1448,6 +1473,11 @@ buffer."
   (interactive)
   (notmuch-common-do-stash (notmuch-show-get-message-id)))
 
+(defun notmuch-show-stash-message-id-stripped ()
+  "Copy message ID of current message (sans `id:' prefix) to kill-ring."
+  (interactive)
+  (notmuch-common-do-stash (substring (notmuch-show-get-message-id) 4 -1)))
+
 (defun notmuch-show-stash-subject ()
   "Copy Subject field of current message to kill-ring."
   (interactive)