X-Git-Url: https://git.notmuchmail.org/git?a=blobdiff_plain;f=emacs%2Fnotmuch.el;h=c47c6b56854fe59eabd9ecc40b1445242e5c38a0;hb=459c5869678161495076f166264a967243c233f4;hp=80446be6b8b2a12b8de7be9396a322376b1c3332;hpb=21474f0e09defa26421b356100c55299afeb19ef;p=notmuch diff --git a/emacs/notmuch.el b/emacs/notmuch.el index 80446be6..c47c6b56 100644 --- a/emacs/notmuch.el +++ b/emacs/notmuch.el @@ -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 "") '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))))