Allow :bind ("C-c C-c" . (lambda () (ding))) and #'(lambda ...)

Fixes https://github.com/jwiegley/use-package/issues/333
Fixes https://github.com/jwiegley/use-package/issues/461
This commit is contained in:
John Wiegley 2017-11-29 14:41:12 -08:00
parent f256943f9b
commit bff472ea80
3 changed files with 193 additions and 127 deletions

View file

@ -267,10 +267,10 @@ function symbol (unquoted)."
(cl-mapcan (cl-mapcan
(lambda (form) (lambda (form)
(if prefix-map (if prefix-map
`((bind-key ,(car form) ',(cdr form) ,prefix-map ,filter)) `((bind-key ,(car form) #',(cdr form) ,prefix-map ,filter))
(if (and map (not (eq map 'global-map))) (if (and map (not (eq map 'global-map)))
`((bind-key ,(car form) ',(cdr form) ,map ,filter)) `((bind-key ,(car form) #',(cdr form) ,map ,filter))
`((bind-key ,(car form) ',(cdr form) nil ,filter))))) `((bind-key ,(car form) #',(cdr form) nil ,filter)))))
first)) first))
(when next (when next
(bind-keys-form (bind-keys-form
@ -305,7 +305,7 @@ function symbol (unquoted)."
(cond (cond
((listp elem) ((listp elem)
(cond (cond
((eq 'lambda (car elem)) ((memq (car elem) '(lambda function))
(if (and bind-key-describe-special-forms (if (and bind-key-describe-special-forms
(stringp (nth 2 elem))) (stringp (nth 2 elem)))
(nth 2 elem) (nth 2 elem)

View file

@ -472,6 +472,9 @@ This is in contrast to merely setting it to 0."
"Delete all empty lists from ELEMS (nil or (list nil)), and append them." "Delete all empty lists from ELEMS (nil or (list nil)), and append them."
(apply #'nconc (delete nil (delete (list nil) elems)))) (apply #'nconc (delete nil (delete (list nil) elems))))
(defsubst use-package--non-nil-symbolp (sym)
(and sym (symbolp sym)))
(defconst use-package-font-lock-keywords (defconst use-package-font-lock-keywords
'(("(\\(use-package\\)\\_>[ \t']*\\(\\(?:\\sw\\|\\s_\\)+\\)?" '(("(\\(use-package\\)\\_>[ \t']*\\(\\(?:\\sw\\|\\s_\\)+\\)?"
(1 font-lock-keyword-face) (1 font-lock-keyword-face)
@ -489,16 +492,11 @@ This is in contrast to merely setting it to 0."
;;; Normalization functions ;;; Normalization functions
;; ;;
(defun use-package-regex-p (re) (defsubst use-package-regex-p (re)
"Return t if RE is some regexp-like thing." "Return t if RE is some regexp-like thing."
(cond (or (and (listp re)
((and (listp re)
(eq (car re) 'rx)) (eq (car re) 'rx))
t) (stringp re)))
((stringp re)
t)
(t
nil)))
(defun use-package-normalize-regex (re) (defun use-package-normalize-regex (re)
"Given some regexp-like thing, resolve it down to a regular expression." "Given some regexp-like thing, resolve it down to a regular expression."
@ -590,7 +588,7 @@ next value for the STATE."
(lambda (label arg) (lambda (label arg)
(cond (cond
((stringp arg) arg) ((stringp arg) arg)
((symbolp arg) (symbol-name arg)) ((use-package--non-nil-symbolp arg) (symbol-name arg))
(t (t
(use-package-error (use-package-error
":pin wants an archive name (a string)")))))) ":pin wants an archive name (a string)"))))))
@ -724,7 +722,7 @@ If the package is installed, its entry is removed from
t t
(use-package-only-one (symbol-name keyword) args (use-package-only-one (symbol-name keyword) args
(lambda (label arg) (lambda (label arg)
(if (symbolp arg) (if (use-package--non-nil-symbolp arg)
arg arg
(use-package-error (use-package-error
(concat ":ensure wants an optional package name " (concat ":ensure wants an optional package name "
@ -798,7 +796,7 @@ If the package is installed, its entry is removed from
(defsubst use-package-normalize-value (label arg) (defsubst use-package-normalize-value (label arg)
"Normalize a value." "Normalize a value."
(cond ((null arg) nil) (cond ((null arg) nil)
((symbolp arg) ((use-package--non-nil-symbolp arg)
`(symbol-value ',arg)) `(symbol-value ',arg))
((functionp arg) ((functionp arg)
`(funcall #',arg)) `(funcall #',arg))
@ -831,8 +829,9 @@ If the package is installed, its entry is removed from
"Call F on the first element of ARGS if it has one element, or all of ARGS. "Call F on the first element of ARGS if it has one element, or all of ARGS.
If ALLOW-EMPTY is non-nil, it's OK for ARGS to be an empty list." If ALLOW-EMPTY is non-nil, it's OK for ARGS to be an empty list."
(declare (indent 1)) (declare (indent 1))
(if (or (and (not (null args)) (listp args) (listp (cdr args))) (if (if args
(and allow-empty (null args))) (listp args) (listp (cdr args))
allow-empty)
(if (= (length args) 1) (if (= (length args) 1)
(funcall f label (car args)) (funcall f label (car args))
(funcall f label args)) (funcall f label args))
@ -844,7 +843,7 @@ If ALLOW-EMPTY is non-nil, it's OK for ARGS to be an empty list."
(defun use-package-normalize-symbols (label arg &optional recursed) (defun use-package-normalize-symbols (label arg &optional recursed)
"Normalize a list of symbols." "Normalize a list of symbols."
(cond (cond
((symbolp arg) ((use-package--non-nil-symbolp arg)
(list arg)) (list arg))
((and (not recursed) (listp arg) (listp (cdr arg))) ((and (not recursed) (listp arg) (listp (cdr arg)))
(mapcar #'(lambda (x) (car (use-package-normalize-symbols label x t))) arg)) (mapcar #'(lambda (x) (car (use-package-normalize-symbols label x t))) arg))
@ -859,7 +858,7 @@ If ALLOW-EMPTY is non-nil, it's OK for ARGS to be an empty list."
(defun use-package-normalize-recursive-symbols (label arg) (defun use-package-normalize-recursive-symbols (label arg)
"Normalize a list of symbols." "Normalize a list of symbols."
(cond (cond
((symbolp arg) ((use-package--non-nil-symbolp arg)
arg) arg)
((and (listp arg) (listp (cdr arg))) ((and (listp arg) (listp (cdr arg)))
(mapcar #'(lambda (x) (use-package-normalize-recursive-symbols label x)) (mapcar #'(lambda (x) (use-package-normalize-recursive-symbols label x))
@ -891,7 +890,7 @@ If ALLOW-EMPTY is non-nil, it's OK for ARGS to be an empty list."
(defun use-package-normalize-paths (label arg &optional recursed) (defun use-package-normalize-paths (label arg &optional recursed)
"Normalize a list of filesystem paths." "Normalize a list of filesystem paths."
(cond (cond
((and arg (or (symbolp arg) (functionp arg))) ((and arg (or (use-package--non-nil-symbolp arg) (functionp arg)))
(let ((value (use-package-normalize-value label arg))) (let ((value (use-package-normalize-value label arg)))
(use-package-normalize-paths label (eval value)))) (use-package-normalize-paths label (eval value))))
((stringp arg) ((stringp arg)
@ -986,56 +985,105 @@ If RECURSED is non-nil, recurse into sublists."
((use-package-is-pair arg key-pred val-pred) ((use-package-is-pair arg key-pred val-pred)
(list arg)) (list arg))
((and (not recursed) (listp arg) (listp (cdr arg))) ((and (not recursed) (listp arg) (listp (cdr arg)))
(let ((last-item nil)) (let (last-item)
(mapcar #'(lambda (x) (mapcar
#'(lambda (x)
(prog1 (prog1
(let ((ret (use-package-normalize-pairs (let ((ret (use-package-normalize-pairs
key-pred val-pred name label x t))) key-pred val-pred name label x t)))
;; Currently, the handling of keyword ;; Currently, the handling of keyword arguments by
;; arguments by `use-package' and `bind-key' ;; `use-package' and `bind-key' is non-uniform and
;; is non-uniform and undocumented. As a ;; undocumented. As a result, `use-package-normalize-pairs'
;; result, `use-package-normalize-pairs' (as ;; (as it is currently implemented) does not correctly handle
;; it is currently implemented) does not ;; the keyword-argument syntax of `bind-keys'. A permanent
;; correctly handle the keyword-argument ;; solution to this problem will require a careful
;; syntax of `bind-keys'. A permanent solution ;; consideration of the desired keyword-argument interface
;; to this problem will require a careful ;; for `use-package' and `bind-key'. However, in the
;; consideration of the desired ;; meantime, we have a quick patch to fix a serious bug in
;; keyword-argument interface for ;; the handling of keyword arguments. Namely, the code below
;; `use-package' and `bind-key'. However, in ;; would normally unwrap lists that were passed as keyword
;; the meantime, we have a quick patch to fix ;; arguments (for example, the `:filter' argument in `:bind')
;; a serious bug in the handling of keyword ;; without the (not (keywordp last-item)) clause. See #447
;; arguments. Namely, the code below would ;; for further discussion.
;; normally unwrap lists that were passed as (if (and (listp ret)
;; keyword arguments (for example, the (not (keywordp last-item)))
;; `:filter' argument in `:bind') without
;; the (not (keywordp last-item)) clause. See
;; #447 for further discussion.
(if (and (listp ret) (not (keywordp last-item)))
(car ret) (car ret)
ret)) ret))
(setq last-item x))) arg))) (setq last-item x))) arg)))
(t arg))) (t arg)))
(defun use-package--recognize-function (v &optional additional-pred)
"A predicate that recognizes functional constructions:
sym
'sym
(quote sym)
#'sym
(function sym)
(lambda () ...)
'(lambda () ...)
(quote (lambda () ...))
#'(lambda () ...)
(function (lambda () ...))"
(pcase v
((pred use-package--non-nil-symbolp) t)
(`(,(or 'quote 'function)
,(pred use-package--non-nil-symbolp)) t)
((pred functionp) t)
(`(function (lambda . ,_)) t)
(_ (and additional-pred
(funcall additional-pred v)))))
(defun use-package--normalize-function (v)
"Reduce functional constructions to one of two normal forms:
sym
#'(lambda () ...)"
(pcase v
((pred use-package--non-nil-symbolp) v)
(`(,(or 'quote 'function)
,(and sym (pred use-package--non-nil-symbolp))) sym)
(`(lambda . ,_) v)
(`(quote ,(and lam `(lambda . ,_))) lam)
(`(function ,(and lam `(lambda . ,_))) lam)
(_ v)))
(defun use-package--normalize-commands (args)
"Map over ARGS of the form ((_ . F) ...).
Normalizing functional F's and returning a list of F's
representing symbols (that may need to be autloaded)."
(let ((nargs (mapcar
#'(lambda (x)
(if (consp x)
(cons (car x)
(use-package--normalize-function (cdr x)))
x)) args)))
(cons nargs
(delete nil (mapcar #'(lambda (x)
(and (consp x)
(use-package--non-nil-symbolp (cdr x))
(cdr x))) nargs)))))
(defun use-package-normalize-binder (name keyword args) (defun use-package-normalize-binder (name keyword args)
(use-package-as-one (symbol-name keyword) args (use-package-as-one (symbol-name keyword) args
(lambda (label arg) (lambda (label arg)
(unless (consp arg) (unless (consp arg)
(use-package-error (use-package-error
(concat label " a (<string or vector> . <symbol or string>)" (concat label " a (<string or vector> . <symbol, string or function>)"
" or list of these"))) " or list of these")))
(use-package-normalize-pairs (lambda (k) (or (stringp k) (vectorp k))) (use-package-normalize-pairs
(lambda (b) (or (symbolp b) (stringp b))) #'(lambda (k)
(pcase k
((pred stringp) t)
((pred vectorp) t)))
#'(lambda (v) (use-package--recognize-function v #'stringp))
name label arg)))) name label arg))))
(defalias 'use-package-normalize/:bind 'use-package-normalize-binder) (defalias 'use-package-normalize/:bind 'use-package-normalize-binder)
(defalias 'use-package-normalize/:bind* 'use-package-normalize-binder) (defalias 'use-package-normalize/:bind* 'use-package-normalize-binder)
(defun use-package-handler/:bind (defun use-package-handler/:bind
(name keyword arg rest state &optional bind-macro) (name keyword args rest state &optional bind-macro)
(let ((commands (remq nil (mapcar #'(lambda (arg) (cl-destructuring-bind (nargs . commands)
(if (listp arg) (use-package--normalize-commands args)
(cdr arg)
nil)) arg))))
(use-package-concat (use-package-concat
(use-package-process-keywords name (use-package-process-keywords name
(use-package-sort-keywords (use-package-sort-keywords
@ -1044,7 +1092,7 @@ If RECURSED is non-nil, recurse into sublists."
`((ignore `((ignore
,(macroexpand ,(macroexpand
`(,(if bind-macro bind-macro 'bind-keys) `(,(if bind-macro bind-macro 'bind-keys)
:package ,name ,@arg))))))) :package ,name ,@nargs)))))))
(defun use-package-handler/:bind* (name keyword arg rest state) (defun use-package-handler/:bind* (name keyword arg rest state)
(use-package-handler/:bind name keyword arg rest state 'bind-keys*)) (use-package-handler/:bind name keyword arg rest state 'bind-keys*))
@ -1096,7 +1144,8 @@ deferred until the prefix key sequence is pressed."
#'(lambda () #'(lambda ()
(interactive) (interactive)
(use-package-autoload-keymap (use-package-autoload-keymap
',(cdr binding) ',(use-package-as-symbol name) ,override)))) arg))) ',(cdr binding) ',(use-package-as-symbol name)
,override)))) arg)))
(use-package-concat (use-package-concat
(use-package-process-keywords name (use-package-process-keywords name
(use-package-sort-keywords (use-package-sort-keywords
@ -1117,23 +1166,27 @@ deferred until the prefix key sequence is pressed."
(use-package-as-one (symbol-name keyword) args (use-package-as-one (symbol-name keyword) args
(apply-partially #'use-package-normalize-pairs (apply-partially #'use-package-normalize-pairs
#'use-package-regex-p #'use-package-regex-p
(lambda (m) (and (not (null m)) (symbolp m))) #'(lambda (v) (use-package--recognize-function v #'null))
name))) name)))
(defun use-package-handle-mode (name alist arg rest state) (defun use-package-handle-mode (name alist args rest state)
"Handle keywords which add regexp/mode pairs to an alist." "Handle keywords which add regexp/mode pairs to an alist."
(let* (commands (cl-destructuring-bind (nargs . commands)
(form (mapcar #'(lambda (thing) (use-package--normalize-commands args)
(push (cdr thing) commands) (let ((form
(setcar thing (mapcar
(use-package-normalize-regex (car thing))) #'(lambda (thing)
`(add-to-list ',alist ',thing)) arg))) `(add-to-list
',alist
',(cons (use-package-normalize-regex (car thing))
(cdr thing))))
nargs)))
(use-package-concat (use-package-concat
(use-package-process-keywords name (use-package-process-keywords name
(use-package-sort-keywords (use-package-sort-keywords
(use-package-plist-maybe-put rest :defer t)) (use-package-plist-maybe-put rest :defer t))
(use-package-plist-append state :commands commands)) (use-package-plist-append state :commands commands))
`((ignore ,@form))))) `((ignore ,@form))))))
(defalias 'use-package-normalize/:interpreter 'use-package-normalize-mode) (defalias 'use-package-normalize/:interpreter 'use-package-normalize-mode)
@ -1258,30 +1311,26 @@ deferred until the prefix key sequence is pressed."
;; Load the package after a set amount of idle time, if the argument to ;; Load the package after a set amount of idle time, if the argument to
;; `:defer' was a number. ;; `:defer' was a number.
(when (numberp arg) (when (numberp arg)
`((run-with-idle-timer ,arg nil #'require ',(use-package-as-symbol name) nil t))) `((run-with-idle-timer ,arg nil #'require
',(use-package-as-symbol name) nil t)))
;; Since we deferring load, establish any necessary autoloads, and also ;; Since we deferring load, establish any necessary autoloads, and also
;; keep the byte-compiler happy. ;; keep the byte-compiler happy.
(apply (cl-mapcan
#'nconc
(mapcar
#'(lambda (command) #'(lambda (command)
(when (not (stringp command)) (when (symbolp command)
(append (append
`((unless (fboundp ',command) `((unless (fboundp ',command)
;; Here we are checking the marker value set in ;; Here we are checking the marker value set in
;; `use-package-handler/:ensure' to see if deferred ;; `use-package-handler/:ensure' to see if deferred
;; installation is actually happening. See ;; installation is actually happening. See
;; `use-package-handler/:defer-install' for more ;; `use-package-handler/:defer-install' for more information.
;; information.
,(if (eq (plist-get state :defer-install) :ensure) ,(if (eq (plist-get state :defer-install) :ensure)
(use-package--autoload-with-deferred-install (use-package--autoload-with-deferred-install command name)
command name)
`(autoload #',command ,name-string nil t)))) `(autoload #',command ,name-string nil t))))
(when (bound-and-true-p byte-compile-current-file) (when (bound-and-true-p byte-compile-current-file)
`((eval-when-compile `((eval-when-compile
(declare-function ,command ,name-string))))))) (declare-function ,command ,name-string)))))))
(delete-dups (plist-get state :commands)))) (delete-dups (plist-get state :commands)))
body))) body)))
@ -1293,11 +1342,10 @@ deferred until the prefix key sequence is pressed."
(defalias 'use-package-normalize/:after 'use-package-normalize-recursive-symlist) (defalias 'use-package-normalize/:after 'use-package-normalize-recursive-symlist)
(defun use-package-require-after-load (defun use-package-require-after-load (features)
(features)
"Return form for after any of FEATURES require NAME." "Return form for after any of FEATURES require NAME."
(pcase features (pcase features
((and (pred symbolp) feat) ((and (pred use-package--non-nil-symbolp) feat)
`(lambda (body) `(lambda (body)
(list 'eval-after-load (list 'quote ',feat) (list 'eval-after-load (list 'quote ',feat)
(list 'quote body)))) (list 'quote body))))
@ -1418,27 +1466,27 @@ deferred until the prefix key sequence is pressed."
(defun use-package-normalize/:hook (name keyword args) (defun use-package-normalize/:hook (name keyword args)
(use-package-as-one (symbol-name keyword) args (use-package-as-one (symbol-name keyword) args
(lambda (label arg) (lambda (label arg)
(unless (or (symbolp arg) (consp arg)) (unless (or (use-package--non-nil-symbolp arg) (consp arg))
(use-package-error (use-package-error
(concat label " a <symbol> or (<symbol or list of symbols> . <symbol or function>)" (concat label " a <symbol> or (<symbol or list of symbols> . <symbol or function>)"
" or list of these"))) " or list of these")))
(use-package-normalize-pairs (use-package-normalize-pairs
#'(lambda (k) #'(lambda (k)
(or (symbolp k) (or (use-package--non-nil-symbolp k)
(and (listp k) (and k (let ((every t))
(listp (cdr k)) (while (and every k)
(cl-every #'symbolp k)))) (if (and (consp k)
#'(lambda (v) (use-package--non-nil-symbolp (car k)))
(or (symbolp v) (functionp v))) (setq k (cdr k))
(setq every nil)))
every))))
#'use-package--recognize-function
name label arg)))) name label arg))))
(defun use-package-handler/:hook (name keyword args rest state) (defun use-package-handler/:hook (name keyword args rest state)
"Generate use-package custom keyword code." "Generate use-package custom keyword code."
(let ((commands (let (funs) (cl-destructuring-bind (nargs . commands)
(dolist (def args) (use-package--normalize-commands args)
(if (symbolp (cdr def))
(setq funs (cons (cdr def) funs))))
(nreverse funs))))
(use-package-concat (use-package-concat
(use-package-process-keywords name (use-package-process-keywords name
(if commands (if commands
@ -1456,7 +1504,8 @@ deferred until the prefix key sequence is pressed."
#'(lambda (sym) #'(lambda (sym)
`(add-hook (quote ,(intern (format "%s-hook" sym))) `(add-hook (quote ,(intern (format "%s-hook" sym)))
(function ,fun))) (function ,fun)))
(if (symbolp syms) (list syms) syms)))) args)))) (if (use-package--non-nil-symbolp syms) (list syms) syms))))
nargs))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; ;;
@ -1471,7 +1520,7 @@ deferred until the prefix key sequence is pressed."
(use-package-error (use-package-error
(concat label " a (<symbol> <value> [comment])" (concat label " a (<symbol> <value> [comment])"
" or list of these"))) " or list of these")))
(if (symbolp (car arg)) (if (use-package--non-nil-symbolp (car arg))
(list arg) (list arg)
arg)))) arg))))
@ -1530,7 +1579,7 @@ deferred until the prefix key sequence is pressed."
(cond (cond
((not arg) ((not arg)
(list (use-package-as-mode name))) (list (use-package-as-mode name)))
((symbolp arg) ((use-package--non-nil-symbolp arg)
(list arg)) (list arg))
((stringp arg) ((stringp arg)
(list (cons (use-package-as-mode name) arg))) (list (cons (use-package-as-mode name) arg)))
@ -1569,7 +1618,8 @@ deferred until the prefix key sequence is pressed."
(when (eq :eval (car args)) (when (eq :eval (car args))
;; Handle likely common mistake. ;; Handle likely common mistake.
(use-package-error ":delight mode line constructs must be quoted")) (use-package-error ":delight mode line constructs must be quoted"))
(cond ((and (= (length args) 1) (symbolp (car args))) (cond ((and (= (length args) 1)
(use-package--non-nil-symbolp (car args)))
`(,(nth 0 args) nil ,name)) `(,(nth 0 args) nil ,name))
((= (length args) 2) ((= (length args) 2)
`(,(nth 0 args) ,(nth 1 args) ,name)) `(,(nth 0 args) ,(nth 1 args) ,name))
@ -1584,7 +1634,7 @@ deferred until the prefix key sequence is pressed."
(cond ((null args) (cond ((null args)
`((,(use-package-as-mode name) nil ,name))) `((,(use-package-as-mode name) nil ,name)))
((and (= (length args) 1) ((and (= (length args) 1)
(symbolp (car args))) (use-package--non-nil-symbolp (car args)))
`((,(car args) nil ,name))) `((,(car args) nil ,name)))
((and (= (length args) 1) ((and (= (length args) 1)
(stringp (car args))) (stringp (car args)))
@ -1599,7 +1649,9 @@ deferred until the prefix key sequence is pressed."
`((,(car args) ,@(cdr (nth 1 args)) ,name))) `((,(car args) ,@(cdr (nth 1 args)) ,name)))
(t (mapcar (t (mapcar
(apply-partially #'use-package--normalize-delight-1 name) (apply-partially #'use-package--normalize-delight-1 name)
(if (symbolp (car args)) (list args) args))))) (if (use-package--non-nil-symbolp (car args))
(list args)
args)))))
(defun use-package-handler/:delight (name keyword args rest state) (defun use-package-handler/:delight (name keyword args rest state)
(let ((body (use-package-process-keywords name rest state))) (let ((body (use-package-process-keywords name rest state)))

View file

@ -84,6 +84,20 @@
(should (equal (use-package-normalize-diminish 'foopkg :diminish '(foo . "bar")) (should (equal (use-package-normalize-diminish 'foopkg :diminish '(foo . "bar"))
'((foo . "bar"))))) '((foo . "bar")))))
(ert-deftest use-package--recognize-function-test ()
(should (use-package--recognize-function 'sym))
(should (use-package--recognize-function #'sym))
(should (use-package--recognize-function (lambda () ...)))
(should (use-package--recognize-function '(lambda () ...)))
(should (use-package--recognize-function #'(lambda () ...))))
(ert-deftest use-package--normalize-function-test ()
(should (equal (use-package--normalize-function 'sym) 'sym))
(should (equal (use-package--normalize-function #'sym) 'sym))
(should (equal (use-package--normalize-function (lambda () ...)) (lambda () ...)))
(should (equal (use-package--normalize-function '(lambda () ...)) (lambda () ...)))
(should (equal (use-package--normalize-function #'(lambda () ...)) (lambda () ...))))
;; Local Variables: ;; Local Variables:
;; indent-tabs-mode: nil ;; indent-tabs-mode: nil
;; no-byte-compile: t ;; no-byte-compile: t