]> git.notmuchmail.org Git - notmuch/blobdiff - notmuch.el
notmuch.el: Implement our own notmuch-help instead of describe-mode.
[notmuch] / notmuch.el
index a1c98a56c4dffa1b70603b95a180275d1c83feff..6e548f10f022a4f243bb0d3f3252b9b869780fff 100644 (file)
     (define-key map "r" 'notmuch-show-reply)
     (define-key map "s" 'notmuch-search)
     (define-key map "v" 'notmuch-show-view-all-mime-parts)
-    (define-key map "w" 'notmuch-show-view-raw-message)
+    (define-key map "V" 'notmuch-show-view-raw-message)
+    (define-key map "w" 'notmuch-show-save-attachments)
     (define-key map "x" 'kill-this-buffer)
     (define-key map "+" 'notmuch-show-add-tag)
     (define-key map "-" 'notmuch-show-remove-tag)
     (define-key map (kbd "DEL") 'notmuch-show-rewind)
     (define-key map " " 'notmuch-show-advance-marking-read-and-archiving)
     (define-key map "|" 'notmuch-show-pipe-message)
-    (define-key map "?" 'describe-mode)
+    (define-key map "?" 'notmuch-help)
     (define-key map (kbd "TAB") 'notmuch-show-next-button)
     (define-key map (kbd "M-TAB") 'notmuch-show-previous-button)
     map)
@@ -774,6 +775,42 @@ which this thread was originally shown."
       (notmuch-show-markup-message)))
   (notmuch-show-hide-markers))
 
+(defun notmuch-documentation-first-line (symbol)
+  "Return the first line of the documentation string for SYMBOL."
+  (let ((doc (documentation symbol)))
+    (if doc
+       (with-temp-buffer
+         (insert (documentation symbol))
+         (goto-char (point-min))
+         (let ((beg (point)))
+           (end-of-line)
+           (buffer-substring beg (point))))
+      "")))
+
+(defun notmuch-substitute-one-command-key (binding)
+  "For a key binding, return a string showing a human-readable representation
+of the key as well as the first line of documentation from the bound function."
+  (concat (format-kbd-macro (vector (car binding)))
+         "\t"
+         (notmuch-documentation-first-line (cdr binding))))
+
+(defun notmuch-substitute-command-keys (doc)
+  "Like `substitute-command-keys' but with documentation, not function names."
+  (let ((beg 0))
+    (while (string-match "\\\\{\\([^}[:space:]]*\\)}" doc beg)
+      (let ((map (substring doc (match-beginning 1) (match-end 1))))
+       (setq doc (replace-match (mapconcat 'notmuch-substitute-one-command-key
+                                           (cdr (symbol-value (intern map))) "\n") 1 1 doc)))
+      (setq beg (match-end 0)))
+    doc))
+
+(defun notmuch-help ()
+  "Display help for the current notmuch mode."
+  (interactive)
+  (let ((mode major-mode))
+    (with-help-window (help-buffer)
+      (princ (notmuch-substitute-command-keys (documentation mode t))))))
+
 ;;;###autoload
 (defun notmuch-show-mode ()
   "Major mode for viewing a thread with notmuch.
@@ -808,8 +845,6 @@ view, (remove the \"inbox\" tag from each), with
        mode-name "notmuch-show")
   (setq buffer-read-only t))
 
-;;;###autoload
-
 (defgroup notmuch nil
   "Notmuch mail reader for Emacs."
   :group 'mail)
@@ -878,7 +913,7 @@ thread from that buffer can be show when done with this one)."
                           (setq btn (forward-button 1))
                         (error (setq btn nil)))
                     ))
-                  (beginning-of-buffer)
+                  (goto-char (point-min))
                   ))))
       )))
 
@@ -910,7 +945,7 @@ thread from that buffer can be show when done with this one)."
     (define-key map "\M->" 'notmuch-search-goto-last-thread)
     (define-key map " " 'notmuch-search-scroll-up)
     (define-key map (kbd "<DEL>") 'notmuch-search-scroll-down)
-    (define-key map "?" 'describe-mode)
+    (define-key map "?" 'notmuch-help)
     map)
   "Keymap for \"notmuch search\" buffers.")
 (fset 'notmuch-search-mode-map notmuch-search-mode-map)
@@ -948,6 +983,23 @@ thread from that buffer can be show when done with this one)."
   (goto-char (point-max))
   (forward-line -1))
 
+(defface notmuch-tag-face
+  '((((class color)
+      (background dark))
+     (:foreground "OliveDrab1"))
+    (((class color)
+      (background light))
+     (:foreground "navy blue" :bold t))
+    (t
+     (:bold t)))
+  "Notmuch search mode face used to highligh tags."
+  :group 'notmuch)
+
+(defvar notmuch-tag-face-alist nil
+  "List containing the tag list that need to be highlighed")
+
+(defvar notmuch-search-font-lock-keywords  nil)
+
 ;;;###autoload
 (defun notmuch-search-mode ()
   "Major mode for searching mail with notmuch.
@@ -961,8 +1013,8 @@ keys can be used to add or remove tags from a thread. The 'a' key
 is a convenience key for archiving a thread (removing the
 \"inbox\" tag).
 
-Other useful commands are `notmuch-search-filter' for filtering
-the current search based on an additional query string,
+Other useful commands are `notmuch-search-filter' for
+filtering the current search based on an additional query string,
 `notmuch-search-filter-by-tag' for filtering to include only
 messages with a given tag, and `notmuch-search' to execute a new,
 global search.
@@ -978,13 +1030,25 @@ global search.
   (setq truncate-lines t)
   (setq major-mode 'notmuch-search-mode
        mode-name "notmuch-search")
-  (setq buffer-read-only t))
+  (setq buffer-read-only t)
+  (if (not notmuch-tag-face-alist)
+      (add-to-list 'notmuch-search-font-lock-keywords (list
+               "(\\([^)]*\\))$" '(1  'notmuch-tag-face)))
+    (progn
+  (setq notmuch-search-tags (mapcar 'car notmuch-tag-face-alist))
+  (loop for notmuch-search-tag  in notmuch-search-tags
+    do (add-to-list 'notmuch-search-font-lock-keywords (list
+                               (concat "([^)]*\\(" notmuch-search-tag "\\)[^)]*)$")
+                   `(1  ,(cdr (assoc notmuch-search-tag notmuch-tag-face-alist))))))))
+  (set (make-local-variable 'font-lock-defaults)
+         '(notmuch-search-font-lock-keywords t)))
 
 (defun notmuch-search-find-thread-id ()
   "Return the thread for the current thread"
   (get-text-property (point) 'notmuch-search-thread-id))
 
 (defun notmuch-search-show-thread ()
+  "Display the currently selected thread."
   (interactive)
   (let ((thread-id (notmuch-search-find-thread-id)))
     (if (> (length thread-id) 0)
@@ -1125,12 +1189,13 @@ characters as well as `_.+-'.
     (let ((words action-split))
       (when (null words) (error "No operation given"))
       (while words
-       (unless (string-match-p "^[\+\-][_\+\-\\w]+$" (car words))
+       (unless (string-match-p "^[-+][-+_.[:word:]]+$" (car words))
          (error "Action must be of the form `+thistag -that_tag'"))
        (setq words (cdr words))))
     (apply 'notmuch-call-notmuch-process "tag"
           (append action-split (list notmuch-search-query-string) nil))))
 
+;;;###autoload
 (defun notmuch-search (query &optional oldest-first)
   "Run \"notmuch search\" with the given query string and display results."
   (interactive "sNotmuch search: ")
@@ -1210,6 +1275,8 @@ current search results AND that are tagged with the given tag."
    (list (notmuch-select-tag-with-completion "Filter by tag: ")))
   (notmuch-search (concat notmuch-search-query-string " and tag:" tag) notmuch-search-oldest-first))
 
+
+;;;###autoload
 (defun notmuch ()
   "Run notmuch to display all mail with tag of 'inbox'"
   (interactive)
@@ -1227,7 +1294,7 @@ current search results AND that are tagged with the given tag."
     (define-key map (kbd "RET") 'notmuch-folder-show-search)
     (define-key map "<" 'beginning-of-buffer)
     (define-key map "=" 'notmuch-folder)
-    (define-key map "?" 'describe-mode)
+    (define-key map "?" 'notmuch-help)
     (define-key map [mouse-1] 'notmuch-folder-show-search)
     map)
   "Keymap for \"notmuch folder\" buffers.")
@@ -1285,6 +1352,7 @@ results for the search terms in that line.
     (if search
        (notmuch-search (cdr search) notmuch-search-oldest-first))))
 
+;;;###autoload
 (defun notmuch-folder ()
   "Show the notmuch folder view and update the displayed counts."
   (interactive)