emacs: notmuch-show-header-line: allow format strings and functions

[notmuch] / emacs / notmuch-show.el

diff --git a/emacs/notmuch-show.el b/emacs/notmuch-show.el
index 939f8913f2508d5ff145bdbd6a1477fcf278fae4..203ca7f07bfa3e099a0d2dc54031c9937685dff8 100644 (file)
--- a/emacs/notmuch-show.el
+++ b/emacs/notmuch-show.el
@@ -59,6 +59,7 @@
 (defvar shr-blocked-images)
 (defvar gnus-blocked-images)
 (defvar shr-content-function)
 (defvar shr-blocked-images)
 (defvar gnus-blocked-images)
 (defvar shr-content-function)

+(defvar w3m-ignored-image-url-regexp)

 
 ;;; Options
 
 
 ;;; Options
 


@@ -83,6 +84,33 @@ visible for any given message."
   :type 'boolean
   :group 'notmuch-show)
 
   :type 'boolean
   :group 'notmuch-show)
 

+(defcustom notmuch-show-header-line t
+  "Show a header line in notmuch show buffers.
+
+If t (the default), the header line will contain the current
+message's subject.
+
+If a string, this value is interpreted as a format string to be
+passed to `format-spec` with `%s` as the substitution variable
+for the message's subject.  E.g., to display the subject trimmed
+to a maximum of 80 columns, you could use \"%>-80s\" as format.
+
+If you assign to this variable a function, it will be called with
+the subject as argument, and the return value will be used as the
+header line format.  Since the function is called with the
+message buffer as the current buffer, it is also possible to
+access any other properties of the message, using for instance
+notmuch-show functions such as
+`notmuch-show-get-message-properties'.
+
+Finally, if this variable is set to nil, no header is
+displayed."
+  :type '(choice (const :tag "No header" ni)
+                 (const :tag "Subject" t)
+                 (string :tag "Format")
+                (function :tag "Function"))
+  :group 'notmuch-show)
+

 (defcustom notmuch-show-relative-dates t
   "Display relative dates in the message summary line."
   :type 'boolean
 (defcustom notmuch-show-relative-dates t
   "Display relative dates in the message summary line."
   :type 'boolean


@@ -179,6 +207,8 @@ indentation."
 
 (defvar-local notmuch-show-indent-content t)
 
 
 (defvar-local notmuch-show-indent-content t)
 

+(defvar-local notmuch-show-single-message nil)
+

 (defvar notmuch-show-attachment-debug nil
   "If t log stdout and stderr from attachment handlers.
 
 (defvar notmuch-show-attachment-debug nil
   "If t log stdout and stderr from attachment handlers.
 


@@ -276,7 +306,7 @@ position of the message in the thread."
        (let ((buf (generate-new-buffer (concat "*notmuch-msg-" id "*"))))
         (with-current-buffer buf
           (let ((coding-system-for-read 'no-conversion))
        (let ((buf (generate-new-buffer (concat "*notmuch-msg-" id "*"))))
         (with-current-buffer buf
           (let ((coding-system-for-read 'no-conversion))

-            (call-process notmuch-command nil t nil "show" "--format=raw" id))
+            (notmuch--call-process notmuch-command nil t nil "show" "--format=raw" id))

           ,@body)
         (kill-buffer buf)))))
 
           ,@body)
         (kill-buffer buf)))))
 


@@ -716,21 +746,23 @@ will return nil if the CID is unknown or cannot be retrieved."
   t)
 
 (defun notmuch-show-insert-part-message/rfc822 (msg part _content-type _nth depth _button)
   t)
 
 (defun notmuch-show-insert-part-message/rfc822 (msg part _content-type _nth depth _button)

-  (let* ((message (car (plist-get part :content)))
-        (body (car (plist-get message :body)))
-        (start (point)))
-    ;; 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 message :headers)))
-    ;; Blank line after headers to be compatible with the normal
-    ;; message display.
-    (insert "\n")
-    ;; Show the body
-    (notmuch-show-insert-bodypart msg body depth)
-    (when notmuch-show-indent-multipart
-      (indent-rigidly start (point) 1)))
-  t)
+  (let ((message (car (plist-get part :content))))
+    (and
+     message
+     (let ((body (car (plist-get message :body)))
+          (start (point)))
+       ;; 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 message :headers)))
+       ;; Blank line after headers to be compatible with the normal
+       ;; message display.
+       (insert "\n")
+       ;; Show the body
+       (notmuch-show-insert-bodypart msg body depth)
+       (when notmuch-show-indent-multipart
+        (indent-rigidly start (point) 1))
+       t))))

 
 (defun notmuch-show-insert-part-text/plain (msg part _content-type _nth depth button)
   ;; For backward compatibility we want to apply the text/plain hook
 
 (defun notmuch-show-insert-part-text/plain (msg part _content-type _nth depth button)
   ;; For backward compatibility we want to apply the text/plain hook


@@ -821,7 +853,8 @@ will return nil if the CID is unknown or cannot be retrieved."
     (let ((mm-inline-text-html-with-w3m-keymap nil)
          ;; FIXME: If we block an image, offer a button to load external
          ;; images.
     (let ((mm-inline-text-html-with-w3m-keymap nil)
          ;; FIXME: If we block an image, offer a button to load external
          ;; images.

-         (gnus-blocked-images notmuch-show-text/html-blocked-images))
+         (gnus-blocked-images notmuch-show-text/html-blocked-images)
+         (w3m-ignored-image-url-regexp notmuch-show-text/html-blocked-images))

       (notmuch-show-insert-part-*/* msg part content-type nth depth button))))
 
 ;;; Functions used by notmuch-show--insert-part-text/html-shr
       (notmuch-show-insert-part-*/* msg part content-type nth depth button))))
 
 ;;; Functions used by notmuch-show--insert-part-text/html-shr


@@ -1253,14 +1286,8 @@ matched."
   (let ((buffer-name (generate-new-buffer-name
                      (or buffer-name
                          (concat "*notmuch-" thread-id "*"))))
   (let ((buffer-name (generate-new-buffer-name
                      (or buffer-name
                          (concat "*notmuch-" thread-id "*"))))

-       ;; We override mm-inline-override-types to stop application/*
-       ;; parts from being displayed unless the user has customized
-       ;; it themselves.
-       (mm-inline-override-types
-        (if (equal mm-inline-override-types
-                   (eval (car (get 'mm-inline-override-types 'standard-value))))
-            (cons "application/*" mm-inline-override-types)
-          mm-inline-override-types)))
+       (mm-inline-override-types (notmuch--inline-override-types)))
+

     (pop-to-buffer-same-window (get-buffer-create buffer-name))
     ;; No need to track undo information for this buffer.
     (setq buffer-undo-list t)
     (pop-to-buffer-same-window (get-buffer-create buffer-name))
     ;; No need to track undo information for this buffer.
     (setq buffer-undo-list t)


@@ -1308,6 +1335,18 @@ fallback if the prior matches no messages."
       (push (list thread "and (" context ")") queries))
     queries))
 
       (push (list thread "and (" context ")") queries))
     queries))
 

+(defun notmuch-show--header-line-format ()
+  "Compute the header line format of a notmuch-show buffer."
+  (when notmuch-show-header-line
+    (let* ((s (notmuch-sanitize
+              (notmuch-show-strip-re (notmuch-show-get-subject))))
+          (subject (replace-regexp-in-string "%" "%%" s)))
+      (cond ((stringp notmuch-show-header-line)
+             (format-spec notmuch-show-header-line `((?s . ,subject))))
+           ((functionp notmuch-show-header-line)
+            (funcall notmuch-show-header-line subject))
+           (notmuch-show-header-line subject)))))
+

 (defun notmuch-show--build-buffer (&optional state)
   "Display messages matching the current buffer context.
 
 (defun notmuch-show--build-buffer (&optional state)
   "Display messages matching the current buffer context.
 


@@ -1315,9 +1354,10 @@ Apply the previously saved STATE if supplied, otherwise show the
 first relevant message.
 
 If no messages match the query return NIL."
 first relevant message.
 
 If no messages match the query return NIL."

-  (let* ((cli-args (cons "--exclude=false"
-                        (and notmuch-show-elide-non-matching-messages
-                             (list "--entire-thread=false"))))
+  (let* ((cli-args (list "--exclude=false"))
+        (cli-args (if notmuch-show-elide-non-matching-messages (cons "--entire-thread=false" cli-args) cli-args))
+        ;; "part 0 is the whole message (headers and body)" notmuch-show(1)
+        (cli-args (if notmuch-show-single-message (cons "--part=0" cli-args) cli-args))

         (queries (notmuch-show--build-queries
                   notmuch-show-thread-id notmuch-show-query-context))
         (forest nil)
         (queries (notmuch-show--build-queries
                   notmuch-show-thread-id notmuch-show-query-context))
         (forest nil)


@@ -1328,6 +1368,8 @@ If no messages match the query return NIL."
     (while (and (not forest) queries)
       (setq forest (notmuch-query-get-threads
                    (append cli-args (list "'") (car queries) (list "'"))))
     (while (and (not forest) queries)
       (setq forest (notmuch-query-get-threads
                    (append cli-args (list "'") (car queries) (list "'"))))

+      (when (and forest notmuch-show-single-message)
+       (setq forest (list (list (list forest)))))

       (setq queries (cdr queries)))
     (when forest
       (notmuch-show-insert-forest forest)
       (setq queries (cdr queries)))
     (when forest
       (notmuch-show-insert-forest forest)


@@ -1335,12 +1377,7 @@ If no messages match the query return NIL."
       ;; display changes.
       (notmuch-show-mapc
        (lambda () (notmuch-show-set-prop :orig-tags (notmuch-show-get-tags))))
       ;; display changes.
       (notmuch-show-mapc
        (lambda () (notmuch-show-set-prop :orig-tags (notmuch-show-get-tags))))

-      ;; Set the header line to the subject of the first message.
-      (setq header-line-format
-           (replace-regexp-in-string "%" "%%"
-                                     (notmuch-sanitize
-                                      (notmuch-show-strip-re
-                                       (notmuch-show-get-subject)))))
+      (setq header-line-format (notmuch-show--header-line-format))

       (run-hooks 'notmuch-show-hook)
       (if state
          (notmuch-show-apply-state state)
       (run-hooks 'notmuch-show-hook)
       (if state
          (notmuch-show-apply-state state)


@@ -2025,7 +2062,7 @@ to show, nil otherwise."
     (pop-to-buffer-same-window buf)
     (erase-buffer)
     (let ((coding-system-for-read 'no-conversion))
     (pop-to-buffer-same-window buf)
     (erase-buffer)
     (let ((coding-system-for-read 'no-conversion))

-      (call-process notmuch-command nil t nil "show" "--format=raw" id))
+      (notmuch--call-process notmuch-command nil t nil "show" "--format=raw" id))

     (goto-char (point-min))
     (set-buffer-modified-p nil)
     (setq buffer-read-only t)
     (goto-char (point-min))
     (set-buffer-modified-p nil)
     (setq buffer-read-only t)


@@ -2071,19 +2108,19 @@ message."
     (let ((cwd default-directory)
          (buf (get-buffer-create (concat "*notmuch-pipe*"))))
       (with-current-buffer buf
     (let ((cwd default-directory)
          (buf (get-buffer-create (concat "*notmuch-pipe*"))))
       (with-current-buffer buf

-       (setq buffer-read-only nil)
-       (erase-buffer)
-       ;; Use the originating buffer's working directory instead of
-       ;; that of the pipe buffer.
-       (cd cwd)
-       (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)
-           (pop-to-buffer buf)
-           (message (format "Command '%s' exited abnormally with code %d"
-                            shell-command exit-code))))))))
+       (setq buffer-read-only t)
+       (let ((inhibit-read-only t))
+         (erase-buffer)
+         ;; Use the originating buffer's working directory instead of
+         ;; that of the pipe buffer.
+         (cd cwd)
+         (let ((exit-code (call-process-shell-command shell-command nil buf)))
+           (goto-char (point-max))
+           (set-buffer-modified-p nil)
+           (unless (zerop exit-code)
+             (pop-to-buffer buf)
+             (message (format "Command '%s' exited abnormally with code %d"
+                              shell-command exit-code)))))))))

 
 (defun notmuch-show-tag-message (&rest tag-changes)
   "Change tags for the current message.
 
 (defun notmuch-show-tag-message (&rest tag-changes)
   "Change tags for the current message.