X-Git-Url: https://git.notmuchmail.org/git?a=blobdiff_plain;f=emacs%2Fnotmuch-lib.el;h=fa35fa9fd89384cd16651bd07c767b32f0080ac1;hb=9c1bc977d79808fca5b4fd0c584570bd4da90bef;hp=623f4fad1d4df630136a79b33cc09348d0a85fd0;hpb=6f616bd733eaa010eb68dd588d56d5d909f1631d;p=notmuch

diff --git a/emacs/notmuch-lib.el b/emacs/notmuch-lib.el
index 623f4fad..fa35fa9f 100644
--- a/emacs/notmuch-lib.el
+++ b/emacs/notmuch-lib.el
@@ -168,6 +168,24 @@ Otherwise the output will be returned"
       (notmuch-check-exit-status status (cons notmuch-command args) output)
       output)))
 
+(defvar notmuch--cli-sane-p nil
+  "Cache whether the CLI seems to be configured sanely.")
+
+(defun notmuch-cli-sane-p ()
+  "Return t if the cli seems to be configured sanely."
+  (unless notmuch--cli-sane-p
+    (let ((status (call-process notmuch-command nil nil nil
+				"config" "get" "user.primary_email")))
+      (setq notmuch--cli-sane-p (= status 0))))
+  notmuch--cli-sane-p)
+
+(defun notmuch-assert-cli-sane ()
+  (unless (notmuch-cli-sane-p)
+    (notmuch-logged-error
+     "notmuch cli seems misconfigured or unconfigured."
+"Perhaps you haven't run \"notmuch setup\" yet? Try running this
+on the command line, and then retry your notmuch command")))
+
 (defun notmuch-version ()
   "Return a string with the notmuch version number."
   (let ((long-string
@@ -231,17 +249,58 @@ depending on the value of `notmuch-poll-script'."
   "Given a prefix key code, return a human-readable string representation.
 
 This is basically just `format-kbd-macro' but we also convert ESC to M-."
-  (let ((desc (format-kbd-macro (vector key))))
+  (let* ((key-vector (if (vectorp key) key (vector key)))
+	 (desc (format-kbd-macro key-vector)))
     (if (string= desc "ESC")
 	"M-"
       (concat desc " "))))
 
-(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.
+(defun notmuch-describe-key (actual-key binding prefix ua-keys tail)
+  "Prepend cons cells describing prefix-arg ACTUAL-KEY and ACTUAL-KEY to TAIL
+
+It does not prepend if ACTUAL-KEY is already listed in TAIL."
+  (let ((key-string (concat prefix (format-kbd-macro actual-key))))
+    ;; We don't include documentation if the key-binding is
+    ;; over-ridden. Note, over-riding a binding automatically hides the
+    ;; prefixed version too.
+    (unless (assoc key-string tail)
+      (when (and ua-keys (symbolp binding)
+		 (get binding 'notmuch-prefix-doc))
+	;; Documentation for prefixed command
+	(let ((ua-desc (key-description ua-keys)))
+	  (push (cons (concat ua-desc " " prefix (format-kbd-macro actual-key))
+		      (get binding 'notmuch-prefix-doc))
+		tail)))
+      ;; Documentation for command
+      (push (cons key-string
+		  (or (and (symbolp binding) (get binding 'notmuch-doc))
+		      (notmuch-documentation-first-line binding)))
+	    tail)))
+    tail)
+
+(defun notmuch-describe-remaps (remap-keymap ua-keys base-keymap prefix tail)
+  ;; Remappings are represented as a binding whose first "event" is
+  ;; 'remap.  Hence, if the keymap has any remappings, it will have a
+  ;; binding whose "key" is 'remap, and whose "binding" is itself a
+  ;; keymap that maps not from keys to commands, but from old (remapped)
+  ;; functions to the commands to use in their stead.
+  (map-keymap
+   (lambda (command binding)
+     (mapc
+      (lambda (actual-key)
+	(setq tail (notmuch-describe-key actual-key binding prefix ua-keys tail)))
+      (where-is-internal command base-keymap)))
+   remap-keymap)
+  tail)
+
+(defun notmuch-describe-keymap (keymap ua-keys base-keymap &optional prefix tail)
+  "Return a list of cons cells, each describing one binding in KEYMAP.
+
+Each cons cell consists of a string giving 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
@@ -251,21 +310,13 @@ prefix argument.  PREFIX and TAIL are used internally."
      (cond ((mouse-event-p key) nil)
 	   ((keymapp binding)
 	    (setq tail
-		  (notmuch-describe-keymap
-		   binding ua-keys (notmuch-prefix-key-description key) tail)))
+		  (if (eq key 'remap)
+		      (notmuch-describe-remaps
+		       binding ua-keys base-keymap prefix tail)
+		    (notmuch-describe-keymap
+		     binding ua-keys base-keymap (notmuch-prefix-key-description key) tail))))
 	   (binding
-	    (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))))
+	    (setq tail (notmuch-describe-key (vector key) binding prefix ua-keys tail)))))
    keymap)
   tail)
 
@@ -278,7 +329,8 @@ prefix argument.  PREFIX and TAIL are used internally."
 	       (let* ((keymap-name (substring doc (match-beginning 1) (match-end 1)))
 		      (keymap (symbol-value (intern keymap-name)))
 		      (ua-keys (where-is-internal 'universal-argument keymap t))
-		      (desc-list (notmuch-describe-keymap keymap ua-keys)))
+		      (desc-alist (notmuch-describe-keymap keymap ua-keys keymap))
+		      (desc-list (mapcar (lambda (arg) (concat (car arg) "\t" (cdr arg))) desc-alist)))
 		 (mapconcat #'identity desc-list "\n")))))
 	(setq doc (replace-match desc 1 1 doc)))
       (setq beg (match-end 0)))
@@ -304,6 +356,28 @@ of its command symbol."
       (set-buffer-modified-p nil)
       (view-buffer (current-buffer) 'kill-buffer-if-not-modified))))
 
+(defun notmuch-subkeymap-help ()
+  "Show help for a subkeymap."
+  (interactive)
+  (let* ((key (this-command-keys-vector))
+	(prefix (make-vector (1- (length key)) nil))
+	(i 0))
+    (while (< i (length prefix))
+      (aset prefix i (aref key i))
+      (setq i (1+ i)))
+
+    (let* ((subkeymap (key-binding prefix))
+	   (ua-keys (where-is-internal 'universal-argument nil t))
+	   (prefix-string (notmuch-prefix-key-description prefix))
+	   (desc-alist (notmuch-describe-keymap subkeymap ua-keys subkeymap prefix-string))
+	   (desc-list (mapcar (lambda (arg) (concat (car arg) "\t" (cdr arg))) desc-alist))
+	   (desc (mapconcat #'identity desc-list "\n")))
+      (with-help-window (help-buffer)
+	(with-current-buffer standard-output
+	  (insert "\nPress 'q' to quit this window.\n\n")
+	  (insert desc)))
+      (pop-to-buffer (help-buffer)))))
+
 (defvar notmuch-buffer-refresh-function nil
   "Function to call to refresh the current buffer.")
 (make-variable-buffer-local 'notmuch-buffer-refresh-function)
@@ -457,7 +531,8 @@ the given type."
 (if (>= emacs-major-version 24)
     (defadvice mm-shr (before load-gnus-arts activate)
       (require 'gnus-art nil t)
-      (ad-disable-advice 'mm-shr 'before 'load-gnus-arts)))
+      (ad-disable-advice 'mm-shr 'before 'load-gnus-arts)
+      (ad-activate 'mm-shr)))
 
 (defun notmuch-mm-display-part-inline (msg part nth content-type process-crypto)
   "Use the mm-decode/mm-view functions to display a part in the