[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[elpa] master 55682e7 57/72: Improve handling of heads with duplicate cm
|
From: |
Oleh Krehel |
|
Subject: |
[elpa] master 55682e7 57/72: Improve handling of heads with duplicate cmd |
|
Date: |
Fri, 06 Mar 2015 13:04:21 +0000 |
branch: master
commit 55682e74b2ed2e76cac0e43bf72841f8b7767860
Author: Oleh Krehel <address@hidden>
Commit: Oleh Krehel <address@hidden>
Improve handling of heads with duplicate cmd
hydra.el (hydra--delete-duplicates): Modify :cmd-name property of
duplicate head to to name of the head that it duplicates.
Heads are considered duplicate if their CMD and COLOR is the same.
The first of the duplicates gets a defun, the rest call it.
* hydra.el (defhydra): Bring heads into a uniform notation. If a
docstring is missing, set it to "". Set :cmd-name property to the
head's name.
* hydra-test.el: Add tests.
Fixes #52.
---
hydra-test.el | 348 ++++++++++++++++++++++++++++++++++++++++++++++++---------
hydra.el | 47 +++++---
2 files changed, 324 insertions(+), 71 deletions(-)
diff --git a/hydra-test.el b/hydra-test.el
index 2d1b275..b904f2d 100644
--- a/hydra-test.el
+++ b/hydra-test.el
@@ -729,65 +729,307 @@ _f_ auto-fill-mode: %`auto-fill-function
(equal (hydra--head-color
'("a" abbrev-mode :exit nil)
'(nil nil :color teal))
- 'amaranth)
- )
+ 'amaranth))
(ert-deftest hydra-compat-colors-2 ()
- (equal
- (macroexpand
- '(defhydra hydra-test (:color amaranth)
- ("a" fun-a)
- ("b" fun-b :color blue)
- ("c" fun-c :color blue)
- ("d" fun-d :color blue)
- ("e" fun-e :color blue)
- ("f" fun-f :color blue)))
- (macroexpand
- '(defhydra hydra-test (:color teal)
- ("a" fun-a :color red)
- ("b" fun-b)
- ("c" fun-c)
- ("d" fun-d)
- ("e" fun-e)
- ("f" fun-f)))))
+ (should
+ (equal
+ (macroexpand
+ '(defhydra hydra-test (:color amaranth)
+ ("a" fun-a)
+ ("b" fun-b :color blue)
+ ("c" fun-c :color blue)
+ ("d" fun-d :color blue)
+ ("e" fun-e :color blue)
+ ("f" fun-f :color blue)))
+ (macroexpand
+ '(defhydra hydra-test (:color teal)
+ ("a" fun-a :color red)
+ ("b" fun-b)
+ ("c" fun-c)
+ ("d" fun-d)
+ ("e" fun-e)
+ ("f" fun-f))))))
(ert-deftest hydra-compat-colors-3 ()
- (equal
- (macroexpand
- '(defhydra hydra-test ()
- ("a" fun-a)
- ("b" fun-b :color blue)
- ("c" fun-c :color blue)
- ("d" fun-d :color blue)
- ("e" fun-e :color blue)
- ("f" fun-f :color blue)))
- (macroexpand
- '(defhydra hydra-test (:color blue)
- ("a" fun-a :color red)
- ("b" fun-b)
- ("c" fun-c)
- ("d" fun-d)
- ("e" fun-e)
- ("f" fun-f)))))
+ (should
+ (equal
+ (macroexpand
+ '(defhydra hydra-test ()
+ ("a" fun-a)
+ ("b" fun-b :color blue)
+ ("c" fun-c :color blue)
+ ("d" fun-d :color blue)
+ ("e" fun-e :color blue)
+ ("f" fun-f :color blue)))
+ (macroexpand
+ '(defhydra hydra-test (:color blue)
+ ("a" fun-a :color red)
+ ("b" fun-b)
+ ("c" fun-c)
+ ("d" fun-d)
+ ("e" fun-e)
+ ("f" fun-f))))))
(ert-deftest hydra-compat-colors-4 ()
- (equal
- (macroexpand
- '(defhydra hydra-test ()
- ("a" fun-a)
- ("b" fun-b :exit t)
- ("c" fun-c :exit t)
- ("d" fun-d :exit t)
- ("e" fun-e :exit t)
- ("f" fun-f :exit t)))
- (macroexpand
- '(defhydra hydra-test (:exit t)
- ("a" fun-a :exit nil)
- ("b" fun-b)
- ("c" fun-c)
- ("d" fun-d)
- ("e" fun-e)
- ("f" fun-f)))))
+ (should
+ (equal
+ (macroexpand
+ '(defhydra hydra-test ()
+ ("a" fun-a)
+ ("b" fun-b :exit t)
+ ("c" fun-c :exit t)
+ ("d" fun-d :exit t)
+ ("e" fun-e :exit t)
+ ("f" fun-f :exit t)))
+ (macroexpand
+ '(defhydra hydra-test (:exit t)
+ ("a" fun-a :exit nil)
+ ("b" fun-b)
+ ("c" fun-c)
+ ("d" fun-d)
+ ("e" fun-e)
+ ("f" fun-f))))))
+
+(ert-deftest hydra-zoom-duplicate-1 ()
+ (should
+ (equal
+ (macroexpand
+ '(defhydra hydra-zoom ()
+ "zoom"
+ ("r" (text-scale-set 0) "reset")
+ ("0" (text-scale-set 0) :bind nil :exit t)
+ ("1" (text-scale-set 0) nil :bind nil :exit t)))
+ '(progn
+ (defun hydra-zoom/lambda-r nil "Create a hydra with no body and the
heads:
+
+\"r\": `(text-scale-set 0)',
+\"0\": `(text-scale-set 0)',
+\"1\": `(text-scale-set 0)'
+
+The body can be accessed via `hydra-zoom/body'.
+
+Call the head: `(text-scale-set 0)'."
+ (interactive)
+ (hydra-disable)
+ (catch (quote hydra-disable)
+ (condition-case err (prog1 t (call-interactively (function
(lambda nil (interactive)
+
(text-scale-set 0)))))
+ ((quit error)
+ (message "%S" err)
+ (unless hydra-lv (sit-for 0.8))
+ nil))
+ (when hydra-is-helpful (hydra-zoom/hint))
+ (setq hydra-last
+ (hydra-set-transient-map
+ (setq hydra-curr-map
+ (quote (keymap (7 . hydra-keyboard-quit)
+ (114 . hydra-zoom/lambda-r)
+ (kp-subtract .
hydra--negative-argument)
+ (kp-9 . hydra--digit-argument)
+ (kp-8 . hydra--digit-argument)
+ (kp-7 . hydra--digit-argument)
+ (kp-6 . hydra--digit-argument)
+ (kp-5 . hydra--digit-argument)
+ (kp-4 . hydra--digit-argument)
+ (kp-3 . hydra--digit-argument)
+ (kp-2 . hydra--digit-argument)
+ (kp-1 . hydra--digit-argument)
+ (kp-0 . hydra--digit-argument)
+ (57 . hydra--digit-argument)
+ (56 . hydra--digit-argument)
+ (55 . hydra--digit-argument)
+ (54 . hydra--digit-argument)
+ (53 . hydra--digit-argument)
+ (52 . hydra--digit-argument)
+ (51 . hydra--digit-argument)
+ (50 . hydra--digit-argument)
+ (49 . hydra-zoom/lambda-0)
+ (48 . hydra-zoom/lambda-0)
+ (45 . hydra--negative-argument)
+ (21 . hydra--universal-argument))))
+ t (lambda nil (hydra-cleanup))))))
+ (defun hydra-zoom/lambda-0 nil "Create a hydra with no body and the
heads:
+
+\"r\": `(text-scale-set 0)',
+\"0\": `(text-scale-set 0)',
+\"1\": `(text-scale-set 0)'
+
+The body can be accessed via `hydra-zoom/body'.
+
+Call the head: `(text-scale-set 0)'."
+ (interactive)
+ (hydra-disable)
+ (hydra-cleanup)
+ (catch (quote hydra-disable)
+ (call-interactively (function (lambda nil (interactive)
+ (text-scale-set 0))))))
+ (defun hydra-zoom/hint nil
+ (if hydra-lv (lv-message (format #("zoom: [r 0]: reset." 7 8 (face
hydra-face-red)
+ 9 10 (face hydra-face-blue))))
+ (message (format #("zoom: [r 0]: reset." 7 8 (face hydra-face-red)
+ 9 10 (face hydra-face-blue))))))
+ (defun hydra-zoom/body nil "Create a hydra with no body and the heads:
+
+\"r\": `(text-scale-set 0)',
+\"0\": `(text-scale-set 0)',
+\"1\": `(text-scale-set 0)'
+
+The body can be accessed via `hydra-zoom/body'."
+ (interactive)
+ (hydra-disable)
+ (catch (quote hydra-disable)
+ (when hydra-is-helpful (hydra-zoom/hint))
+ (setq hydra-last
+ (hydra-set-transient-map
+ (setq hydra-curr-map
+ (quote (keymap (7 . hydra-keyboard-quit)
+ (114 . hydra-zoom/lambda-r)
+ (kp-subtract .
hydra--negative-argument)
+ (kp-9 . hydra--digit-argument)
+ (kp-8 . hydra--digit-argument)
+ (kp-7 . hydra--digit-argument)
+ (kp-6 . hydra--digit-argument)
+ (kp-5 . hydra--digit-argument)
+ (kp-4 . hydra--digit-argument)
+ (kp-3 . hydra--digit-argument)
+ (kp-2 . hydra--digit-argument)
+ (kp-1 . hydra--digit-argument)
+ (kp-0 . hydra--digit-argument)
+ (57 . hydra--digit-argument)
+ (56 . hydra--digit-argument)
+ (55 . hydra--digit-argument)
+ (54 . hydra--digit-argument)
+ (53 . hydra--digit-argument)
+ (52 . hydra--digit-argument)
+ (51 . hydra--digit-argument)
+ (50 . hydra--digit-argument)
+ (49 . hydra-zoom/lambda-0)
+ (48 . hydra-zoom/lambda-0)
+ (45 . hydra--negative-argument)
+ (21 . hydra--universal-argument))))
+ t (lambda nil (hydra-cleanup))))
+ (setq prefix-arg current-prefix-arg)))))))
+
+(ert-deftest hydra-zoom-duplicate-2 ()
+ (should
+ (equal
+ (macroexpand
+ '(defhydra hydra-zoom ()
+ "zoom"
+ ("r" (text-scale-set 0) "reset")
+ ("0" (text-scale-set 0) :bind nil :exit t)
+ ("1" (text-scale-set 0) nil :bind nil)))
+ '(progn
+ (defun hydra-zoom/lambda-r nil "Create a hydra with no body and the
heads:
+
+\"r\": `(text-scale-set 0)',
+\"0\": `(text-scale-set 0)',
+\"1\": `(text-scale-set 0)'
+
+The body can be accessed via `hydra-zoom/body'.
+
+Call the head: `(text-scale-set 0)'."
+ (interactive)
+ (hydra-disable)
+ (catch (quote hydra-disable)
+ (condition-case err (prog1 t (call-interactively (function
(lambda nil (interactive)
+
(text-scale-set 0)))))
+ ((quit error)
+ (message "%S" err)
+ (unless hydra-lv (sit-for 0.8))
+ nil))
+ (when hydra-is-helpful (hydra-zoom/hint))
+ (setq hydra-last
+ (hydra-set-transient-map
+ (setq hydra-curr-map
+ (quote (keymap (7 . hydra-keyboard-quit)
+ (114 . hydra-zoom/lambda-r)
+ (kp-subtract .
hydra--negative-argument)
+ (kp-9 . hydra--digit-argument)
+ (kp-8 . hydra--digit-argument)
+ (kp-7 . hydra--digit-argument)
+ (kp-6 . hydra--digit-argument)
+ (kp-5 . hydra--digit-argument)
+ (kp-4 . hydra--digit-argument)
+ (kp-3 . hydra--digit-argument)
+ (kp-2 . hydra--digit-argument)
+ (kp-1 . hydra--digit-argument)
+ (kp-0 . hydra--digit-argument)
+ (57 . hydra--digit-argument)
+ (56 . hydra--digit-argument)
+ (55 . hydra--digit-argument)
+ (54 . hydra--digit-argument)
+ (53 . hydra--digit-argument)
+ (52 . hydra--digit-argument)
+ (51 . hydra--digit-argument)
+ (50 . hydra--digit-argument)
+ (49 . hydra-zoom/lambda-r)
+ (48 . hydra-zoom/lambda-0)
+ (45 . hydra--negative-argument)
+ (21 . hydra--universal-argument))))
+ t (lambda nil (hydra-cleanup))))))
+ (defun hydra-zoom/lambda-0 nil "Create a hydra with no body and the
heads:
+
+\"r\": `(text-scale-set 0)',
+\"0\": `(text-scale-set 0)',
+\"1\": `(text-scale-set 0)'
+
+The body can be accessed via `hydra-zoom/body'.
+
+Call the head: `(text-scale-set 0)'."
+ (interactive)
+ (hydra-disable)
+ (hydra-cleanup)
+ (catch (quote hydra-disable)
+ (call-interactively (function (lambda nil (interactive)
+ (text-scale-set 0))))))
+ (defun hydra-zoom/hint nil
+ (if hydra-lv (lv-message (format #("zoom: [r 0]: reset." 7 8 (face
hydra-face-red)
+ 9 10 (face hydra-face-blue))))
+ (message (format #("zoom: [r 0]: reset." 7 8 (face hydra-face-red)
+ 9 10 (face hydra-face-blue))))))
+ (defun hydra-zoom/body nil "Create a hydra with no body and the heads:
+
+\"r\": `(text-scale-set 0)',
+\"0\": `(text-scale-set 0)',
+\"1\": `(text-scale-set 0)'
+
+The body can be accessed via `hydra-zoom/body'."
+ (interactive)
+ (hydra-disable)
+ (catch (quote hydra-disable)
+ (when hydra-is-helpful (hydra-zoom/hint))
+ (setq hydra-last
+ (hydra-set-transient-map
+ (setq hydra-curr-map
+ (quote (keymap (7 . hydra-keyboard-quit)
+ (114 . hydra-zoom/lambda-r)
+ (kp-subtract .
hydra--negative-argument)
+ (kp-9 . hydra--digit-argument)
+ (kp-8 . hydra--digit-argument)
+ (kp-7 . hydra--digit-argument)
+ (kp-6 . hydra--digit-argument)
+ (kp-5 . hydra--digit-argument)
+ (kp-4 . hydra--digit-argument)
+ (kp-3 . hydra--digit-argument)
+ (kp-2 . hydra--digit-argument)
+ (kp-1 . hydra--digit-argument)
+ (kp-0 . hydra--digit-argument)
+ (57 . hydra--digit-argument)
+ (56 . hydra--digit-argument)
+ (55 . hydra--digit-argument)
+ (54 . hydra--digit-argument)
+ (53 . hydra--digit-argument)
+ (52 . hydra--digit-argument)
+ (51 . hydra--digit-argument)
+ (50 . hydra--digit-argument)
+ (49 . hydra-zoom/lambda-r)
+ (48 . hydra-zoom/lambda-0)
+ (45 . hydra--negative-argument)
+ (21 . hydra--universal-argument))))
+ t (lambda nil (hydra-cleanup))))
+ (setq prefix-arg current-prefix-arg)))))))
(provide 'hydra-test)
diff --git a/hydra.el b/hydra.el
index 0f501d5..ecbc409 100644
--- a/hydra.el
+++ b/hydra.el
@@ -630,13 +630,19 @@ NAME, BODY and HEADS are parameters to `defhydra'."
(concat "lambda-" (car h))))))
(defun hydra--delete-duplicates (heads)
- "Delete heads calling the same thing from HEADS."
- (let (lst res)
- (mapc (lambda (h)
- (unless (member (cadr h) lst)
- (push h res))
- (push (cadr h) lst))
- heads)
+ "Return HEADS without entries that have the same CMD part.
+In duplicate HEADS, :cmd-name is modified to whatever they duplicate."
+ (let (res ali entry)
+ (dolist (h heads)
+ (if (setq entry (assoc (cons (cadr h)
+ (hydra--head-color h '(nil nil)))
+ ali))
+ (setf (cl-cdddr h) (plist-put (cl-cdddr h) :cmd-name (cdr entry)))
+ (push (cons (cons (cadr h)
+ (hydra--head-color h '(nil nil)))
+ (plist-get (cl-cdddr h) :cmd-name))
+ ali)
+ (push h res)))
(nreverse res)))
;;* Macros
@@ -699,14 +705,18 @@ result of `defhydra'."
(when (keywordp (car body))
(setq body (cons nil (cons nil body))))
(dolist (h heads)
- (cond ((< (length h) 2)
- (error "Each head should have at least two items: %S" h))
- ((= (length h) 2)
- (setcdr (cdr h) '("")))
- ((or (null (cl-caddr h))
- (stringp (cl-caddr h))))
- (t
- (setcdr (cdr h) (cons "" (cddr h))))))
+ (let ((len (length h))
+ (cmd-name (hydra--head-name h name)))
+ (cond ((< len 2)
+ (error "Each head should have at least two items: %S" h))
+ ((= len 2)
+ (setcdr (cdr h) `("" :cmd-name ,cmd-name)))
+ (t
+ (let ((hint (cl-caddr h)))
+ (unless (or (null hint)
+ (stringp hint))
+ (setcdr (cdr h) (cons "" (cddr h))))
+ (setcdr (cddr h) `(:cmd-name ,cmd-name ,@(cl-cdddr h))))))))
(let* ((keymap (copy-keymap hydra-base-map))
(body-name (intern (format "%S/body" name)))
(body-key (unless (hydra--callablep body)
@@ -717,11 +727,12 @@ result of `defhydra'."
(body-post (plist-get (cddr body) :post))
(method (or (plist-get body :bind)
(car body)))
- (doc (hydra--doc body-key body-name heads)))
+ (doc (hydra--doc body-key body-name heads))
+ (heads-nodup (hydra--delete-duplicates heads)))
(mapc
(lambda (x)
(define-key keymap (kbd (car x))
- (hydra--head-name x name)))
+ (plist-get (cl-cdddr x) :cmd-name)))
heads)
(when (and body-pre (symbolp body-pre))
(setq body-pre `(funcall #',body-pre)))
@@ -735,7 +746,7 @@ result of `defhydra'."
(lambda (head)
(hydra--make-defun name body doc head keymap
body-pre body-post))
- (hydra--delete-duplicates heads))
+ heads-nodup)
,@(unless (or (null body-key)
(null method)
(hydra--callablep method))
- [elpa] master 5242aad 48/72: Fix :exit t / :exit nil inheritance issue, (continued)
- [elpa] master 5242aad 48/72: Fix :exit t / :exit nil inheritance issue, Oleh Krehel, 2015/03/06
- [elpa] master 0f733d8 37/72: Add an option to fontify heads in a custom way, Oleh Krehel, 2015/03/06
- [elpa] master c413b5f 54/72: Allow for a custom key format spec in docstrings, Oleh Krehel, 2015/03/06
- [elpa] master 54004d2 52/72: hydra.el (hydra-verbose): New defcustom, Oleh Krehel, 2015/03/06
- [elpa] master 0d9c95e 47/72: Update README.md, Oleh Krehel, 2015/03/06
- [elpa] master 3c06695 56/72: Amend the key regex in docstring to include <>, Oleh Krehel, 2015/03/06
- [elpa] master e567bd6 59/72: lv.el (lv-window): set-window-parameter 'no-other-window, Oleh Krehel, 2015/03/06
- [elpa] master eb1e0fc 58/72: Don't bind nil heads in outside keymaps, Oleh Krehel, 2015/03/06
- [elpa] master 41ec124 50/72: Avoid generating multiple defuns with same name, Oleh Krehel, 2015/03/06
- [elpa] master db0415e 49/72: hydra.el (hydra-keyboard-quit): Add, Oleh Krehel, 2015/03/06
- [elpa] master 55682e7 57/72: Improve handling of heads with duplicate cmd,
Oleh Krehel <=
- [elpa] master 7de26d0 64/72: Add `hydra-repeat': hydra-specific `repeat', Oleh Krehel, 2015/03/06
- [elpa] master f231dc0 55/72: Simplify the hint part of each head, Oleh Krehel, 2015/03/06
- [elpa] master 764f4b6 67/72: hydra.el (hydra--format): Amend key regex, Oleh Krehel, 2015/03/06
- [elpa] master 8e90037 65/72: Add some features for generating tables, Oleh Krehel, 2015/03/06
- [elpa] master 3040f45 61/72: hydra.el (hydra--format): Amend key regex, Oleh Krehel, 2015/03/06
- [elpa] master e1e2e3e 69/72: lv.el (lv-window): Bind `golden-ratio-mode' to nil, Oleh Krehel, 2015/03/06
- [elpa] master 8dec3cd 70/72: Allow for a %s(test) spec in docstring, Oleh Krehel, 2015/03/06
- [elpa] master 9fc928b 63/72: hydra.el (hydra--format): Amend key regex, Oleh Krehel, 2015/03/06
- [elpa] master 989ed95 53/72: Rename compat toggle - :nonheads -> :foreign-keys, Oleh Krehel, 2015/03/06
- [elpa] master 9c68e0a 68/72: Add :timeout option to hydra body, Oleh Krehel, 2015/03/06