]> git.notmuchmail.org Git - notmuch/blobdiff - emacs/notmuch.el
emacs: Improved `notmuch-describe-keymap' documentation
[notmuch] / emacs / notmuch.el
index 80446be6b8b2a12b8de7be9396a322376b1c3332..c47c6b56854fe59eabd9ecc40b1445242e5c38a0 100644 (file)
@@ -140,53 +140,63 @@ This is basically just `format-kbd-macro' but we also convert ESC to M-."
        "M-"
       (concat desc " "))))
 
-;; I would think that emacs would have code handy for walking a keymap
-;; and generating strings for each key, and I would prefer to just call
-;; that. But I couldn't find any (could be all implemented in C I
-;; suppose), so I wrote my own here.
-(defun notmuch-substitute-one-command-key-with-prefix (prefix binding)
-  "For a key binding, return a string showing a human-readable
-representation of the prefixed key as well as the first line of
-documentation from the bound function.
-
-For a mouse binding, return nil."
-  (let ((key (car binding))
-       (action (cdr binding)))
-    (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)))
-               (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))))))
-
-(defun notmuch-substitute-command-keys-one (key)
-  ;; A `keymap' key indicates inheritance from a parent keymap - the
-  ;; inherited mappings follow, so there is nothing to print for
-  ;; `keymap' itself.
-  (when (not (eq key 'keymap))
-    (notmuch-substitute-one-command-key-with-prefix nil key)))
+(defun notmuch-describe-keymap (keymap ua-keys &optional prefix tail)
+  "Return a list of strings, each describing one binding in KEYMAP.
+
+Each string gives a human-readable description of the key and a
+one-line description of the bound function.  See `notmuch-help'
+for an overview of how this documentation is extracted.
+
+UA-KEYS should be a key sequence bound to `universal-argument'.
+It will be used to describe bindings of commands that support a
+prefix argument.  PREFIX and TAIL are used internally."
+  (map-keymap
+   (lambda (key binding)
+     (cond ((mouse-event-p key) nil)
+          ((keymapp binding)
+           (setq tail
+                 (notmuch-describe-keymap
+                  binding ua-keys (notmuch-prefix-key-description key) tail)))
+          (t
+           (when (and ua-keys (symbolp binding)
+                      (get binding 'notmuch-prefix-doc))
+             ;; Documentation for prefixed command
+             (let ((ua-desc (key-description ua-keys)))
+               (push (concat ua-desc " " prefix (format-kbd-macro (vector key))
+                             "\t" (get binding 'notmuch-prefix-doc))
+                     tail)))
+           ;; Documentation for command
+           (push (concat prefix (format-kbd-macro (vector key)) "\t"
+                         (or (and (symbolp binding) (get binding 'notmuch-doc))
+                             (notmuch-documentation-first-line binding)))
+                 tail))))
+   keymap)
+  tail)
 
 (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* ((keymap-name (substring doc (match-beginning 1) (match-end 1)))
-            (keymap (symbol-value (intern keymap-name))))
-       (setq doc (replace-match
-                  (mapconcat #'notmuch-substitute-command-keys-one
-                             (cdr keymap) "\n")
-                  1 1 doc)))
+            (keymap (symbol-value (intern keymap-name)))
+            (ua-keys (where-is-internal 'universal-argument keymap t))
+            (desc-list (notmuch-describe-keymap keymap ua-keys))
+            (desc (mapconcat #'identity desc-list "\n")))
+       (setq doc (replace-match desc 1 1 doc)))
       (setq beg (match-end 0)))
     doc))
 
 (defun notmuch-help ()
-  "Display help for the current notmuch mode."
+  "Display help for the current notmuch mode.
+
+This is similar to `describe-function' for the current major
+mode, but bindings tables are shown with documentation strings
+rather than command names.  By default, this uses the first line
+of each command's documentation string.  A command can override
+this by setting the 'notmuch-doc property of its command symbol.
+A command that supports a prefix argument can explicitly document
+its prefixed behavior by setting the 'notmuch-prefix-doc property
+of its command symbol."
   (interactive)
   (let* ((mode major-mode)
         (doc (substitute-command-keys (notmuch-substitute-command-keys (documentation mode t)))))
@@ -212,8 +222,7 @@ For a mouse binding, return nil."
 
 (defvar notmuch-search-mode-map
   (let ((map (make-sparse-keymap)))
-    (define-key map "?" 'notmuch-help)
-    (define-key map "q" 'notmuch-kill-this-buffer)
+    (set-keymap-parent map notmuch-common-keymap)
     (define-key map "x" 'notmuch-kill-this-buffer)
     (define-key map (kbd "<DEL>") 'notmuch-search-scroll-down)
     (define-key map "b" 'notmuch-search-scroll-down)
@@ -224,12 +233,8 @@ For a mouse binding, return nil."
     (define-key map "n" 'notmuch-search-next-thread)
     (define-key map "r" 'notmuch-search-reply-to-thread-sender)
     (define-key map "R" 'notmuch-search-reply-to-thread)
-    (define-key map "m" 'notmuch-mua-new-mail)
-    (define-key map "s" 'notmuch-search)
     (define-key map "o" 'notmuch-search-toggle-order)
     (define-key map "c" 'notmuch-search-stash-map)
-    (define-key map "=" 'notmuch-refresh-this-buffer)
-    (define-key map "G" 'notmuch-poll-and-refresh-this-buffer)
     (define-key map "t" 'notmuch-search-filter-by-tag)
     (define-key map "f" 'notmuch-search-filter)
     (define-key map [mouse-1] 'notmuch-search-show-thread)
@@ -575,15 +580,21 @@ See `notmuch-tag' for information on the format of TAG-CHANGES."
     (notmuch-search-tag-region beg end tag-changes)))
 
 (defun notmuch-search-add-tag ()
-  "Same as `notmuch-search-tag' but sets initial input to '+'."
+  "Change tags for the current thread (defaulting to add).
+
+Same as `notmuch-search-tag' but sets initial input to '+'."
   (interactive)
   (notmuch-search-tag "+"))
 
 (defun notmuch-search-remove-tag ()
-  "Same as `notmuch-search-tag' but sets initial input to '-'."
+  "Change tags for the current thread (defaulting to remove).
+
+Same as `notmuch-search-tag' but sets initial input to '-'."
   (interactive)
   (notmuch-search-tag "-"))
 
+(put 'notmuch-search-archive-thread 'notmuch-prefix-doc
+     "Un-archive the currently selected thread.")
 (defun notmuch-search-archive-thread (&optional unarchive)
   "Archive the currently selected thread.
 
@@ -887,16 +898,17 @@ PROMPT is the string to prompt with."
                              'notmuch-search-history nil nil)))))
 
 ;;;###autoload
+(put 'notmuch-search 'notmuch-doc "Search for messages.")
 (defun notmuch-search (&optional query oldest-first target-thread target-line)
-  "Run \"notmuch search\" with the given `query' and display results.
+  "Display threads matching QUERY in a notmuch-search buffer.
 
-If `query' is nil, it is read interactively from the minibuffer.
+If QUERY is nil, it is read interactively from the minibuffer.
 Other optional parameters are used as follows:
 
-  oldest-first: A Boolean controlling the sort order of returned threads
-  target-thread: A thread ID (without the thread: prefix) that will be made
+  OLDEST-FIRST: A Boolean controlling the sort order of returned threads
+  TARGET-THREAD: A thread ID (without the thread: prefix) that will be made
                  current if it appears in the search results.
-  target-line: The line number to move to if the target thread does not
+  TARGET-LINE: The line number to move to if the target thread does not
                appear in the search results.
 
 When called interactively, this will prompt for a query and use
@@ -907,7 +919,7 @@ the configured default sort order."
     nil
     ;; Use the default search order (if we're doing a search from a
     ;; search buffer, ignore any buffer-local overrides)
-    (default-value notmuch-search-oldest-first)))
+    (default-value 'notmuch-search-oldest-first)))
 
   (let* ((query (or query (notmuch-read-query "Notmuch search: ")))
         (buffer (get-buffer-create (notmuch-search-buffer-title query))))