]> git.notmuchmail.org Git - notmuch/blobdiff - emacs/notmuch-show.el
emacs: possibility to customize the rendering of tags
[notmuch] / emacs / notmuch-show.el
index 5248fba6533c3e6dd2ad7cbf828810c656324b7a..a4d2c128588d55a8ece1046fdbbb96c28e8f4b5e 100644 (file)
@@ -94,7 +94,7 @@ visible for any given message."
   :group 'notmuch-hooks)
 
 ;; Mostly useful for debugging.
-(defcustom notmuch-show-all-multipart/alternative-parts t
+(defcustom notmuch-show-all-multipart/alternative-parts nil
   "Should all parts of multipart/alternative parts be shown?"
   :type 'boolean
   :group 'notmuch-show)
@@ -362,8 +362,7 @@ operation on the contents of the current buffer."
     (if (re-search-forward "(\\([^()]*\\))$" (line-end-position) t)
        (let ((inhibit-read-only t))
          (replace-match (concat "("
-                                (propertize (mapconcat 'identity tags " ")
-                                            'face 'notmuch-tag-face)
+                                (notmuch-tag-format-tags tags)
                                 ")"))))))
 
 (defun notmuch-clean-address (address)
@@ -441,8 +440,7 @@ message at DEPTH in the current thread."
            " ("
            date
            ") ("
-           (propertize (mapconcat 'identity tags " ")
-                       'face 'notmuch-tag-face)
+           (notmuch-tag-format-tags tags)
            ")\n")
     (overlay-put (make-overlay start (point)) 'face 'notmuch-message-summary-face)))
 
@@ -469,7 +467,8 @@ message at DEPTH in the current thread."
   'action 'notmuch-show-part-button-default
   'keymap 'notmuch-show-part-button-map
   'follow-link t
-  'face 'message-mml)
+  'face 'message-mml
+  :supertype 'notmuch-button-type)
 
 (defvar notmuch-show-part-button-map
   (let ((map (make-sparse-keymap)))
@@ -554,6 +553,25 @@ message at DEPTH in the current thread."
     (let ((handle (mm-make-handle (current-buffer) (list content-type))))
       (mm-pipe-part handle))))
 
+;; This is taken from notmuch-wash: maybe it should be unified?
+(defun notmuch-show-toggle-part-invisibility (&optional button)
+  (interactive)
+  (let* ((button (or button (button-at (point))))
+        (overlay (button-get button 'overlay)))
+    (when overlay
+      (let* ((show (overlay-get overlay 'invisible))
+            (new-start (button-start button))
+            (button-label (button-get button :base-label))
+            (old-point (point))
+            (inhibit-read-only t))
+       (overlay-put overlay 'invisible (not show))
+       (goto-char new-start)
+       (insert "[ " button-label (if show " ]" " (hidden) ]"))
+       (let ((old-end (button-end button)))
+         (move-overlay button new-start (point))
+         (delete-region (point) old-end))
+       (goto-char (min old-point (1- (button-end button))))))))
+
 (defun notmuch-show-multipart/*-to-list (part)
   (mapcar (lambda (inner-part) (plist-get inner-part :content-type))
          (plist-get part :content)))
@@ -567,11 +585,10 @@ message at DEPTH in the current thread."
     ;; but it's not clear that this is the wrong thing to do - which
     ;; should be chosen if there are more than one that match?
     (mapc (lambda (inner-part)
-           (let ((inner-type (plist-get inner-part :content-type)))
-             (if (or notmuch-show-all-multipart/alternative-parts
-                     (string= chosen-type inner-type))
-                 (notmuch-show-insert-bodypart msg inner-part depth)
-               (notmuch-show-insert-part-header (plist-get inner-part :id) inner-type inner-type nil " (not shown)"))))
+           (let* ((inner-type (plist-get inner-part :content-type))
+                 (hide (not (or notmuch-show-all-multipart/alternative-parts
+                          (string= chosen-type inner-type)))))
+             (notmuch-show-insert-bodypart msg inner-part depth hide)))
          inner-parts)
 
     (when notmuch-show-indent-multipart
@@ -800,6 +817,16 @@ message at DEPTH in the current thread."
 (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-text/html (msg part content-type nth depth declared-type)
+  ;; text/html handler to work around bugs in renderers and our
+  ;; invisibile parts code. In particular w3m sets up a keymap which
+  ;; "leaks" outside the invisible region and causes strange effects
+  ;; in notmuch. We set mm-inline-text-html-with-w3m-keymap to nil to
+  ;; tell w3m not to set a keymap (so the normal notmuch-show-mode-map
+  ;; remains).
+  (let ((mm-inline-text-html-with-w3m-keymap nil))
+    (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.
   (notmuch-show-insert-part-header nth content-type declared-type (plist-get part :filename))
@@ -839,17 +866,38 @@ message at DEPTH in the current thread."
       (setq handlers (cdr handlers))))
   t)
 
-(defun notmuch-show-insert-bodypart (msg part depth)
-  "Insert the body part PART at depth DEPTH in the current thread."
+(defun notmuch-show-create-part-overlays (msg beg end hide)
+  "Add an overlay to the part between BEG and END"
+  (let* ((button (button-at beg))
+        (part-beg (and button (1+ (button-end button)))))
+
+    ;; If the part contains no text we do not make it toggleable. We
+    ;; also need to check that the button is a genuine part button not
+    ;; a notmuch-wash button.
+    (when (and button (/= part-beg end) (button-get button :base-label))
+      (button-put button 'overlay (make-overlay part-beg end))
+      ;; We toggle the button for hidden parts as that gets the
+      ;; button label right.
+      (save-excursion
+       (when hide
+         (notmuch-show-toggle-part-invisibility button))))))
+
+(defun notmuch-show-insert-bodypart (msg part depth &optional hide)
+  "Insert the body part PART at depth DEPTH in the current thread.
+
+If HIDE is non-nil then initially hide this part."
   (let ((content-type (downcase (plist-get part :content-type)))
-       (nth (plist-get part :id)))
-    (notmuch-show-insert-bodypart-internal msg part content-type nth depth content-type))
-  ;; Some of the body part handlers leave point somewhere up in the
-  ;; part, so we make sure that we're down at the end.
-  (goto-char (point-max))
-  ;; Ensure that the part ends with a carriage return.
-  (unless (bolp)
-    (insert "\n")))
+       (nth (plist-get part :id))
+       (beg (point)))
+
+    (notmuch-show-insert-bodypart-internal msg part content-type nth depth content-type)
+    ;; Some of the body part handlers leave point somewhere up in the
+    ;; part, so we make sure that we're down at the end.
+    (goto-char (point-max))
+    ;; Ensure that the part ends with a carriage return.
+    (unless (bolp)
+      (insert "\n"))
+    (notmuch-show-create-part-overlays msg beg (point) hide)))
 
 (defun notmuch-show-insert-body (msg body depth)
   "Insert the body BODY at depth DEPTH in the current thread."
@@ -1036,6 +1084,7 @@ buttons for a corresponding notmuch search."
        ;; Remove the overlay created by goto-address-mode
        (remove-overlays (first link) (second link) 'goto-address t)
        (make-text-button (first link) (second link)
+                         :type 'notmuch-button-type
                          'action `(lambda (arg)
                                     (notmuch-show ,(third link)))
                          'follow-link t
@@ -1938,7 +1987,10 @@ the user (see `notmuch-show-stash-mlarchive-link-alist')."
 
 (defun notmuch-show-part-button-default (&optional button)
   (interactive)
-  (notmuch-show-part-button-internal button notmuch-show-part-button-default-action))
+  (let ((button (or button (button-at (point)))))
+    (if (button-get button 'overlay)
+       (notmuch-show-toggle-part-invisibility button)
+      (notmuch-show-part-button-internal button notmuch-show-part-button-default-action))))
 
 (defun notmuch-show-part-button-save (&optional button)
   (interactive)