[nongnu] elpa/guru-mode 1086b77 20/42: only block keys with bindings in global-map

[ELPA Syncer]

branch: elpa/guru-mode
commit 1086b77b7c037fbbaf76b55d4df786697e3d7bee
Author: Charles Lowell <cowboyd@frontside.io>
Commit: Charles Lowell <cowboyd@frontside.io>

    only block keys with bindings in global-map
    
    Some minor-modes "reclaim" key sequences that are better used through
    their "guru" mappings. An example is smartparens, which binds <C-right>
    to `sp-slurp-forward-sexp` or drag-stuff, which binds <M-up> to
    `drag-stuff-up`. In these instances, we want to check if the key has
    been remapped elsewhere before blocking it.
    
    `guru-affected-bindings-list` has been modified to also contain a
    reference to the original key binding. If, upon entering the original
    key sequence, the bound function is different than the original binding,
    then we let it proceed unhindered.
    
    Some additional fixes:
    
    * remove <M-up> and <M-down> remappings which are not bound to
    anything by default.
    
    * point <home> and <end> to beginning-of-buffer and end-of-buffer
      respectively, since these are what they are bound to by default
---
 guru-mode.el | 70 ++++++++++++++++++++++++++++++++++--------------------------
 1 file changed, 40 insertions(+), 30 deletions(-)

diff --git a/guru-mode.el b/guru-mode.el
index 1d75347..885be81 100644
--- a/guru-mode.el
+++ b/guru-mode.el
@@ -39,41 +39,51 @@
   "When non-nil you'll only get an error message.")
 
 (defvar guru-affected-bindings-list
-  '(("<left>" . "C-b")
-    ("<right>" . "C-f")
-    ("<up>" . "C-p")
-    ("<down>" . "C-n")
-    ("<C-left>" . "M-b")
-    ("<C-right>" . "M-f")
-    ("<C-up>" . "M-{")
-    ("<C-down>" . "M-}")
-    ("<M-left>" . "M-b")
-    ("<M-right>" . "M-f")
-    ("<M-up>" . "M-{")
-    ("<M-down>" . "M-}")
-    ("<delete>" . "C-d")
-    ("<C-delete>" . "M-d")
-    ("<M-delete>" . "M-d")
-    ("<next>" . "C-v")
-    ("<C-next>" . "M-x <")
-    ("<prior>" . "M-v")
-    ("<C-prior>" . "M-x >")
-    ("<home>" . "C-a")
-    ("<C-home>" . "M-<")
-    ("<end>" . "C-e")
-    ("<C-end>" . "M->")))
+  '(("<left>" "C-b" left-char)
+    ("<right>" "C-f" right-char)
+    ("<up>" "C-p" previous-line)
+    ("<down>" "C-n" next-line)
+    ("<C-left>" "M-b" left-word)
+    ("<C-right>" "M-f" right-word)
+    ("<C-up>" "M-{" backward-paragraph)
+    ("<C-down>" "M-}" forward-paragraph)
+    ("<M-left>" "M-b" left-word)
+    ("<M-right>" "M-f" right-word)
+    ("<delete>" "C-d" delete-char)
+    ("<C-delete>" "M-d" kill-word)
+    ("<next>" "C-v" scroll-up-command)
+    ("<C-next>" "M-x <" scroll-left)
+    ("<prior>" "M-v" scroll-down-command)
+    ("<C-prior>" "M-x >" scroll-right)
+    ("<home>" "M-<" beginning-of-buffer)
+    ("<C-home>" "M-<" beginning-of-buffer)
+    ("<end>" "M->" end-of-buffer)
+    ("<C-end>" "M->" end-of-buffer)))
 
-(defun guru-rebind (original-key alt-key)
+(defun guru-current-key-binding (key)
+  "Look up the current binding for KEY without guru-mode."
+  (prog2 (guru-mode -1) (key-binding (kbd key)) (guru-mode +1)))
+
+(defun guru-rebind (original-key alt-key original-binding)
   (lambda ()
     (interactive)
-    (let ((warning-text (if guru-warn-only "discouraged" "disabled")))
-      (message "%s keybinding is %s! Use <%s> instead" original-key 
warning-text alt-key))
-    (when guru-warn-only
-      (call-interactively (key-binding (kbd alt-key))))))
+    (let ((current-binding (guru-current-key-binding original-key)))
+      (if (eq current-binding original-binding)
+          (progn
+            (let ((warning-text (if guru-warn-only "discouraged" "disabled")))
+              (message "%s keybinding is %s! Use <%s> instead" original-key 
warning-text alt-key))
+            (when guru-warn-only
+              (call-interactively (key-binding (kbd alt-key)))))
+        ;; else: the key has been re-mapped from the global default,
+        ;; use it without interference.
+        (call-interactively current-binding)))))
 
 (dolist (cell guru-affected-bindings-list)
-  (define-key guru-mode-map
-    (read-kbd-macro (car cell)) (guru-rebind (car cell) (cdr cell))))
+  (let ((original-key (car cell))
+        (recommended-key (car (cdr cell)))
+        (original-binding (car (cdr (cdr cell)))))
+    (define-key guru-mode-map
+      (read-kbd-macro (car cell)) (guru-rebind original-key recommended-key 
original-binding))))
 
 ;;;###autoload
 (define-minor-mode guru-mode