1
Fork 0
mirror of git://git.sv.gnu.org/emacs.git synced 2025-12-06 06:20:55 -08:00

Rewrite normalization of :bind and :bind*

Fixes https://github.com/jwiegley/use-package/issues/550
This commit is contained in:
John Wiegley 2017-12-05 13:11:30 -08:00
parent 725d749b7c
commit 65caa3b423
2 changed files with 175 additions and 25 deletions

View file

@ -67,17 +67,44 @@ deferred until the prefix key sequence is pressed."
package keymap-symbol))))) package keymap-symbol)))))
(defun use-package-normalize-binder (name keyword args) (defun use-package-normalize-binder (name keyword args)
(use-package-as-one (symbol-name keyword) args (let ((arg args)
#'(lambda (label arg) args*)
(unless (consp arg) (while arg
(let ((x (car arg)))
(cond
;; (KEY . COMMAND)
((and (consp x)
(or (stringp (car x))
(vectorp (car x)))
(or (use-package-recognize-function (cdr x) t #'stringp)))
(setq args* (nconc args* (list x)))
(setq arg (cdr arg)))
;; KEYWORD
;; :map KEYMAP
;; :prefix-docstring STRING
;; :prefix-map SYMBOL
;; :prefix STRING
;; :filter SEXP
;; :menu-name STRING
((or (and (eq x :map) (symbolp (cadr arg)))
(and (eq x :prefix) (stringp (cadr arg)))
(and (eq x :prefix-map) (symbolp (cadr arg)))
(and (eq x :prefix-docstring) (stringp (cadr arg)))
(eq x :filter)
(and (eq x :menu-name) (stringp (cadr arg))))
(setq args* (nconc args* (list x (cadr arg))))
(setq arg (cddr arg)))
((listp x)
(setq args*
(nconc args* (use-package-normalize-binder name keyword x)))
(setq arg (cdr arg)))
(t
;; Error!
(use-package-error (use-package-error
(concat label " a (<string or vector> . <symbol, string or function>)" (concat (symbol-name name)
" or list of these"))) " wants arguments acceptable to the `bind-keys' macro,"
(use-package-normalize-pairs " or a list of such values"))))))
#'(lambda (k) (cond ((stringp k) t) args*))
((vectorp k) t)))
#'(lambda (v) (use-package-recognize-function v t #'stringp))
name label arg))))
;;;; :bind, :bind* ;;;; :bind, :bind*

View file

@ -546,26 +546,115 @@
(eval-when-compile (eval-when-compile
(with-demoted-errors "Cannot load foo: %S" nil nil)))))) (with-demoted-errors "Cannot load foo: %S" nil nil))))))
(ert-deftest use-package-test-normalize/:bind () (defun use-package-test-normalize-bind (&rest args)
(flet ((norm (&rest args) (apply #'use-package-normalize-binder 'foo :bind args))
(apply #'use-package-normalize-binder
'foopkg :bind args))) (ert-deftest use-package-test-normalize/:bind-1 ()
(let ((good-values '(:map map-sym (should (equal (use-package-test-normalize-bind
("str" . sym) ("str" . "str") '(("C-a" . alpha)))
([vec] . sym) ([vec] . "str")))) '(("C-a" . alpha)))))
(should (equal (norm good-values) good-values)))
(should-error (norm '("foo"))) (ert-deftest use-package-test-normalize/:bind-2 ()
(should-error (norm '("foo" . 99))) (should (equal (use-package-test-normalize-bind
(should-error (norm '(99 . sym))))) '(("C-a" . alpha)
:map foo-map
("C-b" . beta)))
'(("C-a" . alpha)
:map foo-map
("C-b" . beta)))))
(ert-deftest use-package-test-normalize/:bind-3 ()
(should (equal (use-package-test-normalize-bind
'(:map foo-map
("C-a" . alpha)
("C-b" . beta)))
'(:map foo-map
("C-a" . alpha)
("C-b" . beta)))))
(ert-deftest use-package-test/:bind-1 () (ert-deftest use-package-test/:bind-1 ()
(match-expansion (match-expansion
(use-package foo :bind ("C-k" . key)) (use-package foo :bind ("C-k" . key1) ("C-u" . key2))
`(progn `(progn
(unless (fboundp 'key) (unless
(autoload #'key "foo" nil t)) (fboundp 'key1)
(autoload #'key1 "foo" nil t))
(unless
(fboundp 'key2)
(autoload #'key2 "foo" nil t))
(ignore (ignore
(bind-keys :package foo ("C-k" . key)))))) (bind-keys :package foo
("C-k" . key1)
("C-u" . key2))))))
(ert-deftest use-package-test/:bind-2 ()
(match-expansion
(use-package foo :bind (("C-k" . key1) ("C-u" . key2)))
`(progn
(unless (fboundp 'key1)
(autoload #'key1 "foo" nil t))
(unless (fboundp 'key2)
(autoload #'key2 "foo" nil t))
(ignore
(bind-keys :package foo
("C-k" . key1)
("C-u" . key2))))))
(ert-deftest use-package-test/:bind-3 ()
(match-expansion
(use-package foo :bind (:map my-map ("C-k" . key1) ("C-u" . key2)))
`(progn
(unless
(fboundp 'key1)
(autoload #'key1 "foo" nil t))
(unless
(fboundp 'key2)
(autoload #'key2 "foo" nil t))
(ignore
(bind-keys :package foo :map my-map
("C-k" . key1)
("C-u" . key2))))))
(ert-deftest use-package-test/:bind-4 ()
(should-error
(match-expansion
(use-package foo :bind :map my-map ("C-k" . key1) ("C-u" . key2))
`(ignore
(bind-keys :package foo)))))
(ert-deftest use-package-test/:bind-5 ()
(match-expansion
(use-package foo :bind ("C-k" . key1) (:map my-map ("C-u" . key2)))
`(progn
(unless (fboundp 'key1)
(autoload #'key1 "foo" nil t))
(unless (fboundp 'key2)
(autoload #'key2 "foo" nil t))
(ignore
(bind-keys :package foo
("C-k" . key1)
:map my-map
("C-u" . key2))))))
(ert-deftest use-package-test/:bind-6 ()
(match-expansion
(use-package foo
:bind
("C-k" . key1)
(:map my-map ("C-u" . key2))
(:map my-map2 ("C-u" . key3)))
`(progn
(unless (fboundp 'key1)
(autoload #'key1 "foo" nil t))
(unless (fboundp 'key2)
(autoload #'key2 "foo" nil t))
(unless (fboundp 'key3)
(autoload #'key3 "foo" nil t))
(ignore
(bind-keys :package foo
("C-k" . key1)
:map my-map ("C-u" . key2)
:map my-map2 ("C-u" . key3))))))
(ert-deftest use-package-test/:bind*-1 () (ert-deftest use-package-test/:bind*-1 ()
(match-expansion (match-expansion
@ -1524,6 +1613,40 @@
(use-package-ensure-elpa 'hydra '(t) 'nil) (use-package-ensure-elpa 'hydra '(t) 'nil)
(require 'hydra nil nil)))) (require 'hydra nil nil))))
(ert-deftest use-package-test/545 ()
(match-expansion
(use-package spacemacs-theme
:ensure t
:init ; or :config
(load-theme 'spacemacs-dark t)
)
`(progn
(use-package-ensure-elpa 'spacemacs-theme '(t) 'nil)
(load-theme 'spacemacs-dark t)
(require 'spacemacs-theme nil nil))
))
(ert-deftest use-package-test/550 ()
(match-expansion
(use-package company-try-hard
:ensure t
:bind
("C-c M-/" . company-try-hard)
(:map company-active-map
("C-c M-/" . company-try-hard)))
`(progn
(use-package-ensure-elpa 'company-try-hard
'(t)
'nil)
(unless
(fboundp 'company-try-hard)
(autoload #'company-try-hard "company-try-hard" nil t))
(ignore
(bind-keys :package company-try-hard
("C-c M-/" . company-try-hard)
:map company-active-map
("C-c M-/" . company-try-hard))))))
(ert-deftest use-package-test/558 () (ert-deftest use-package-test/558 ()
(match-expansion (match-expansion
(bind-keys* :package org-ref (bind-keys* :package org-ref