]> git.notmuchmail.org Git - notmuch/blobdiff - notmuch.el
notmuch.el: convert sparse keymap to a list in notmuch-substitute-one-command-key...
[notmuch] / notmuch.el
index 478a69380698cf4e73ee3b484ee42dfb09ce6881..82471b57dc9b4cabb7271e73b61e4a80a4ada3a9 100644 (file)
@@ -133,6 +133,8 @@ remaining lines into a button.")
 (defvar notmuch-show-id-regexp "\\(id:[^ ]*\\)")
 (defvar notmuch-show-depth-match-regexp " depth:\\([0-9]*\\).*match:\\([01]\\) ")
 (defvar notmuch-show-filename-regexp "filename:\\(.*\\)$")
+(defvar notmuch-show-contentype-regexp "Content-type: \\(.*\\)")
+
 (defvar notmuch-show-tags-regexp "(\\([^)]*\\))$")
 
 (defvar notmuch-show-parent-buffer nil)
@@ -223,6 +225,62 @@ Unlike builtin `previous-line' this version accepts no arguments."
     (re-search-forward notmuch-show-tags-regexp)
     (split-string (buffer-substring (match-beginning 1) (match-end 1)))))
 
+(defun notmuch-show-get-bcc ()
+  "Return BCC address(es) of current message"
+  (notmuch-show-get-header-field 'bcc))
+
+(defun notmuch-show-get-cc ()
+  "Return CC address(es) of current message"
+  (notmuch-show-get-header-field 'cc))
+
+(defun notmuch-show-get-date ()
+  "Return Date of current message"
+  (notmuch-show-get-header-field 'date))
+
+(defun notmuch-show-get-from ()
+  "Return From address of current message"
+  (notmuch-show-get-header-field 'from))
+
+(defun notmuch-show-get-subject ()
+  "Return Subject of current message"
+  (notmuch-show-get-header-field 'subject))
+
+(defun notmuch-show-get-to ()
+  "Return To address(es) of current message"
+  (notmuch-show-get-header-field 'to))
+
+(defun notmuch-show-get-header-field (name)
+  "Retrieve the header field NAME from the current message.
+NAME should be a symbol, in lower case, as returned by
+mail-header-extract-no-properties"
+  (let* ((result (assoc name (notmuch-show-get-header)))
+        (val (and result (cdr result))))
+    val))
+
+(defun notmuch-show-get-header ()
+  "Retrieve and parse the header from the current message. Returns an alist with of (header . value)
+where header is a symbol and value is a string.  The summary from notmuch-show is returned as the
+pseudoheader summary"
+  (require 'mailheader)
+  (save-excursion
+    (beginning-of-line)
+    (if (not (looking-at notmuch-show-message-begin-regexp))
+       (re-search-backward notmuch-show-message-begin-regexp))
+    (re-search-forward (concat notmuch-show-header-begin-regexp "\n[[:space:]]*\\(.*\\)\n"))
+    (let* ((summary (buffer-substring-no-properties (match-beginning 1) (match-end 1)))
+         (beg (point)))
+      (re-search-forward notmuch-show-header-end-regexp)
+      (let ((text (buffer-substring beg (match-beginning 0))))
+       (with-temp-buffer
+         (insert text)
+         (goto-char (point-min))
+         (while (looking-at "\\([[:space:]]*\\)[A-Za-z][-A-Za-z0-9]*:")
+           (delete-region (match-beginning 1) (match-end 1))
+           (forward-line)
+           )
+         (goto-char (point-min))
+         (cons (cons 'summary summary) (mail-header-extract-no-properties)))))))
+
 (defun notmuch-show-add-tag (&rest toadd)
   "Add a tag to the current message."
   (interactive
@@ -319,13 +377,28 @@ buffer."
          (with-current-buffer buf
            (insert-file-contents filename nil nil nil t)
            ,@body)
-        (kill-buffer buf)))))
+        (kill-buffer buf)))))
 
 (defun notmuch-show-view-all-mime-parts ()
   "Use external viewers to view all attachments from the current message."
   (interactive)
   (with-current-notmuch-show-message
-   (mm-display-parts (mm-dissect-buffer))))
+   ; We ovverride the mm-inline-media-tests to indicate which message
+   ; parts are already sufficiently handled by the original
+   ; presentation of the message in notmuch-show mode. These parts
+   ; will be inserted directly into the temporary buffer of
+   ; with-current-notmuch-show-message and silently discarded.
+   ;
+   ; Any MIME part not explicitly mentioned here will be handled by an
+   ; external viewer as configured in the various mailcap files.
+   (let ((mm-inline-media-tests '(
+                                 ("text/.*" ignore identity)
+                                 ("application/pgp-signature" ignore identity)
+                                 ("multipart/alternative" ignore identity)
+                                 ("multipart/mixed" ignore identity)
+                                 ("multipart/related" ignore identity)
+                                )))
+     (mm-display-parts (mm-dissect-buffer)))))
 
 (defun notmuch-foreach-mime-part (function mm-handle)
   (cond ((stringp (car mm-handle))
@@ -622,7 +695,7 @@ which this thread was originally shown."
 (define-button-type 'notmuch-button-invisibility-toggle-type
   'action 'notmuch-toggle-invisible-action
   'follow-link t
-  'face "default")
+  'face 'font-lock-comment-face)
 (define-button-type 'notmuch-button-citation-toggle-type 'help-echo "mouse-1, RET: Show citation"
   :supertype 'notmuch-button-invisibility-toggle-type)
 (define-button-type 'notmuch-button-signature-toggle-type 'help-echo "mouse-1, RET: Show signature"
@@ -713,19 +786,44 @@ is what to put on the button."
 (defun notmuch-show-markup-part (beg end depth)
   (if (re-search-forward notmuch-show-part-begin-regexp nil t)
       (progn
-       (forward-line)
-       (let ((beg (point-marker)))
-         (re-search-forward notmuch-show-part-end-regexp)
-         (let ((end (copy-marker (match-beginning 0))))
-           (goto-char end)
-           (if (not (bolp))
-               (insert "\n"))
-           (indent-rigidly beg end depth)
-           (notmuch-show-markup-citations-region beg end depth)
-           ; Advance to the next part (if any) (so the outer loop can
-           ; determine whether we've left the current message.
-           (if (re-search-forward notmuch-show-part-begin-regexp nil t)
-               (beginning-of-line)))))
+        (let (mime-message mime-type)
+          (save-excursion
+            (re-search-forward notmuch-show-contentype-regexp end t)
+            (setq mime-type (car (split-string (buffer-substring
+                                                (match-beginning 1) (match-end 1))))))
+
+          (if (equal mime-type "text/html")
+              (let ((filename (notmuch-show-get-filename)))
+                (with-temp-buffer
+                  (insert-file-contents filename nil nil nil t)
+                  (setq mime-message (mm-dissect-buffer)))))
+          (forward-line)
+          (let ((beg (point-marker)))
+            (re-search-forward notmuch-show-part-end-regexp)
+            (let ((end (copy-marker (match-beginning 0))))
+              (goto-char end)
+              (if (not (bolp))
+                  (insert "\n"))
+              (indent-rigidly beg end depth)
+              (if (not (eq mime-message nil))
+                  (save-excursion
+                    (goto-char beg)
+                    (forward-line -1)
+                    (let ((handle-type (mm-handle-type mime-message))
+                          mime-type)
+                      (if (sequencep (car handle-type))
+                          (setq mime-type (car handle-type))
+                        (setq mime-type (car (car (cdr handle-type))))
+                        )
+                      (if (equal mime-type "text/html")
+                          (mm-display-part mime-message))))
+                )
+              (notmuch-show-markup-citations-region beg end depth)
+              ; Advance to the next part (if any) (so the outer loop can
+              ; determine whether we've left the current message.
+              (if (re-search-forward notmuch-show-part-begin-regexp nil t)
+                  (beginning-of-line)))))
+        (goto-char end))
     (goto-char end)))
 
 (defun notmuch-show-markup-parts-region (beg end depth)
@@ -902,8 +1000,12 @@ For a mouse binding, return nil."
     (if (mouse-event-p key)
        nil
       (if (keymapp action)
-         (let ((substitute (apply-partially 'notmuch-substitute-one-command-key-with-prefix (notmuch-prefix-key-description key))))
-           (mapconcat substitute (cdr action) "\n"))
+         (let ((substitute (apply-partially 'notmuch-substitute-one-command-key-with-prefix (notmuch-prefix-key-description key)))
+               (as-list))
+           (map-keymap (lambda (a b)
+                         (push (cons a b) as-list))
+                       action)
+           (mapconcat substitute as-list "\n"))
        (concat prefix (format-kbd-macro (vector key))
                "\t"
                (notmuch-documentation-first-line action))))))
@@ -1308,7 +1410,7 @@ This function advances the next thread when finished."
                  (more t)
                  (inhibit-read-only t))
              (while more
-               (if (string-match "^\\(thread:[0-9A-Fa-f]*\\) \\(.*\\) \\(\\[[0-9/]*\\]\\) \\([^:]*\\); \\(.*\\) (\\([^()]*\\))$" string line)
+               (if (string-match "^\\(thread:[0-9A-Fa-f]*\\) \\(.*\\) \\(\\[[0-9/]*\\]\\) \\([^;]*\\); \\(.*\\) (\\([^()]*\\))$" string line)
                    (let* ((thread-id (match-string 1 string))
                           (date (match-string 2 string))
                           (count (match-string 3 string))
@@ -1446,12 +1548,15 @@ current search results AND that are tagged with the given tag."
     (define-key map "?" 'notmuch-help)
     (define-key map "x" 'kill-this-buffer)
     (define-key map "q" 'kill-this-buffer)
+    (define-key map "m" 'message-mail)
+    (define-key map "e" 'notmuch-folder-show-empty-toggle)
     (define-key map ">" 'notmuch-folder-last)
     (define-key map "<" 'notmuch-folder-first)
     (define-key map "=" 'notmuch-folder)
     (define-key map "s" 'notmuch-search)
     (define-key map [mouse-1] 'notmuch-folder-show-search)
     (define-key map (kbd "RET") 'notmuch-folder-show-search)
+    (define-key map " " 'notmuch-folder-show-search)
     (define-key map "p" 'notmuch-folder-previous)
     (define-key map "n" 'notmuch-folder-next)
     map)
@@ -1521,22 +1626,40 @@ Currently available key bindings:
   (goto-char (point-max))
   (forward-line -1))
 
+(defun notmuch-folder-count (search)
+  (car (process-lines notmuch-command "count" search)))
+
+(setq notmuch-folder-show-empty t)
+
+(defun notmuch-folder-show-empty-toggle ()
+  "Toggle the listing of empty folders"
+  (interactive)
+  (setq notmuch-folder-show-empty (not notmuch-folder-show-empty))
+  (notmuch-folder))
+
 (defun notmuch-folder-add (folders)
   (if folders
-      (let ((name (car (car folders)))
+      (let* ((name (car (car folders)))
            (inhibit-read-only t)
-           (search (cdr (car folders))))
-       (insert name)
-       (indent-to 16 1)
-       (call-process notmuch-command nil t nil "count" search)
+           (search (cdr (car folders)))
+           (count (notmuch-folder-count search)))
+       (if (or notmuch-folder-show-empty
+               (not (equal count "0")))
+           (progn
+             (insert name)
+             (indent-to 16 1)
+             (insert count)
+             (insert "\n")
+             )
+         )
        (notmuch-folder-add (cdr folders)))))
 
 (defun notmuch-folder-find-name ()
   (save-excursion
     (beginning-of-line)
     (let ((beg (point)))
-      (forward-word)
-      (filter-buffer-substring beg (point)))))
+      (re-search-forward "\\([ \t]*[^ \t]+\\)")
+      (filter-buffer-substring (match-beginning 1) (match-end 1)))))
 
 (defun notmuch-folder-show-search (&optional folder)
   "Show a search window for the search related to the specified folder."