mirror of
https://github.com/masscollaborationlabs/emacs.git
synced 2025-07-06 20:29:36 +00:00
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
parent
f256943f9b
commit
bff472ea80
3 changed files with 193 additions and 127 deletions
|
|
@ -267,10 +267,10 @@ function symbol (unquoted)."
|
|||
(cl-mapcan
|
||||
(lambda (form)
|
||||
(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)))
|
||||
`((bind-key ,(car form) ',(cdr form) ,map ,filter))
|
||||
`((bind-key ,(car form) ',(cdr form) nil ,filter)))))
|
||||
`((bind-key ,(car form) #',(cdr form) ,map ,filter))
|
||||
`((bind-key ,(car form) #',(cdr form) nil ,filter)))))
|
||||
first))
|
||||
(when next
|
||||
(bind-keys-form
|
||||
|
|
@ -305,7 +305,7 @@ function symbol (unquoted)."
|
|||
(cond
|
||||
((listp elem)
|
||||
(cond
|
||||
((eq 'lambda (car elem))
|
||||
((memq (car elem) '(lambda function))
|
||||
(if (and bind-key-describe-special-forms
|
||||
(stringp (nth 2 elem)))
|
||||
(nth 2 elem)
|
||||
|
|
|
|||
|
|
@ -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."
|
||||
(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
|
||||
'(("(\\(use-package\\)\\_>[ \t']*\\(\\(?:\\sw\\|\\s_\\)+\\)?"
|
||||
(1 font-lock-keyword-face)
|
||||
|
|
@ -489,16 +492,11 @@ This is in contrast to merely setting it to 0."
|
|||
;;; Normalization functions
|
||||
;;
|
||||
|
||||
(defun use-package-regex-p (re)
|
||||
(defsubst use-package-regex-p (re)
|
||||
"Return t if RE is some regexp-like thing."
|
||||
(cond
|
||||
((and (listp re)
|
||||
(or (and (listp re)
|
||||
(eq (car re) 'rx))
|
||||
t)
|
||||
((stringp re)
|
||||
t)
|
||||
(t
|
||||
nil)))
|
||||
(stringp re)))
|
||||
|
||||
(defun use-package-normalize-regex (re)
|
||||
"Given some regexp-like thing, resolve it down to a regular expression."
|
||||
|
|
@ -590,7 +588,7 @@ next value for the STATE."
|
|||
(lambda (label arg)
|
||||
(cond
|
||||
((stringp arg) arg)
|
||||
((symbolp arg) (symbol-name arg))
|
||||
((use-package--non-nil-symbolp arg) (symbol-name arg))
|
||||
(t
|
||||
(use-package-error
|
||||
":pin wants an archive name (a string)"))))))
|
||||
|
|
@ -724,7 +722,7 @@ If the package is installed, its entry is removed from
|
|||
t
|
||||
(use-package-only-one (symbol-name keyword) args
|
||||
(lambda (label arg)
|
||||
(if (symbolp arg)
|
||||
(if (use-package--non-nil-symbolp arg)
|
||||
arg
|
||||
(use-package-error
|
||||
(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)
|
||||
"Normalize a value."
|
||||
(cond ((null arg) nil)
|
||||
((symbolp arg)
|
||||
((use-package--non-nil-symbolp arg)
|
||||
`(symbol-value ',arg))
|
||||
((functionp 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.
|
||||
If ALLOW-EMPTY is non-nil, it's OK for ARGS to be an empty list."
|
||||
(declare (indent 1))
|
||||
(if (or (and (not (null args)) (listp args) (listp (cdr args)))
|
||||
(and allow-empty (null args)))
|
||||
(if (if args
|
||||
(listp args) (listp (cdr args))
|
||||
allow-empty)
|
||||
(if (= (length args) 1)
|
||||
(funcall f label (car 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)
|
||||
"Normalize a list of symbols."
|
||||
(cond
|
||||
((symbolp arg)
|
||||
((use-package--non-nil-symbolp arg)
|
||||
(list arg))
|
||||
((and (not recursed) (listp arg) (listp (cdr 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)
|
||||
"Normalize a list of symbols."
|
||||
(cond
|
||||
((symbolp arg)
|
||||
((use-package--non-nil-symbolp arg)
|
||||
arg)
|
||||
((and (listp arg) (listp (cdr arg)))
|
||||
(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)
|
||||
"Normalize a list of filesystem paths."
|
||||
(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)))
|
||||
(use-package-normalize-paths label (eval value))))
|
||||
((stringp arg)
|
||||
|
|
@ -986,56 +985,105 @@ If RECURSED is non-nil, recurse into sublists."
|
|||
((use-package-is-pair arg key-pred val-pred)
|
||||
(list arg))
|
||||
((and (not recursed) (listp arg) (listp (cdr arg)))
|
||||
(let ((last-item nil))
|
||||
(mapcar #'(lambda (x)
|
||||
(let (last-item)
|
||||
(mapcar
|
||||
#'(lambda (x)
|
||||
(prog1
|
||||
(let ((ret (use-package-normalize-pairs
|
||||
key-pred val-pred name label x t)))
|
||||
;; Currently, the handling of keyword
|
||||
;; arguments by `use-package' and `bind-key'
|
||||
;; is non-uniform and undocumented. As a
|
||||
;; result, `use-package-normalize-pairs' (as
|
||||
;; it is currently implemented) does not
|
||||
;; correctly handle the keyword-argument
|
||||
;; syntax of `bind-keys'. A permanent solution
|
||||
;; to this problem will require a careful
|
||||
;; consideration of the desired
|
||||
;; keyword-argument interface for
|
||||
;; `use-package' and `bind-key'. However, in
|
||||
;; the meantime, we have a quick patch to fix
|
||||
;; a serious bug in the handling of keyword
|
||||
;; arguments. Namely, the code below would
|
||||
;; normally unwrap lists that were passed as
|
||||
;; keyword arguments (for example, the
|
||||
;; `:filter' argument in `:bind') without
|
||||
;; the (not (keywordp last-item)) clause. See
|
||||
;; #447 for further discussion.
|
||||
(if (and (listp ret) (not (keywordp last-item)))
|
||||
;; Currently, the handling of keyword arguments by
|
||||
;; `use-package' and `bind-key' is non-uniform and
|
||||
;; undocumented. As a result, `use-package-normalize-pairs'
|
||||
;; (as it is currently implemented) does not correctly handle
|
||||
;; the keyword-argument syntax of `bind-keys'. A permanent
|
||||
;; solution to this problem will require a careful
|
||||
;; consideration of the desired keyword-argument interface
|
||||
;; for `use-package' and `bind-key'. However, in the
|
||||
;; meantime, we have a quick patch to fix a serious bug in
|
||||
;; the handling of keyword arguments. Namely, the code below
|
||||
;; would normally unwrap lists that were passed as keyword
|
||||
;; arguments (for example, the `: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)
|
||||
ret))
|
||||
(setq last-item x))) 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)
|
||||
(use-package-as-one (symbol-name keyword) args
|
||||
(lambda (label arg)
|
||||
(unless (consp arg)
|
||||
(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")))
|
||||
(use-package-normalize-pairs (lambda (k) (or (stringp k) (vectorp k)))
|
||||
(lambda (b) (or (symbolp b) (stringp b)))
|
||||
(use-package-normalize-pairs
|
||||
#'(lambda (k)
|
||||
(pcase k
|
||||
((pred stringp) t)
|
||||
((pred vectorp) t)))
|
||||
#'(lambda (v) (use-package--recognize-function v #'stringp))
|
||||
name label arg))))
|
||||
|
||||
(defalias 'use-package-normalize/:bind 'use-package-normalize-binder)
|
||||
(defalias 'use-package-normalize/:bind* 'use-package-normalize-binder)
|
||||
|
||||
(defun use-package-handler/:bind
|
||||
(name keyword arg rest state &optional bind-macro)
|
||||
(let ((commands (remq nil (mapcar #'(lambda (arg)
|
||||
(if (listp arg)
|
||||
(cdr arg)
|
||||
nil)) arg))))
|
||||
(name keyword args rest state &optional bind-macro)
|
||||
(cl-destructuring-bind (nargs . commands)
|
||||
(use-package--normalize-commands args)
|
||||
(use-package-concat
|
||||
(use-package-process-keywords name
|
||||
(use-package-sort-keywords
|
||||
|
|
@ -1044,7 +1092,7 @@ If RECURSED is non-nil, recurse into sublists."
|
|||
`((ignore
|
||||
,(macroexpand
|
||||
`(,(if bind-macro bind-macro 'bind-keys)
|
||||
:package ,name ,@arg)))))))
|
||||
:package ,name ,@nargs)))))))
|
||||
|
||||
(defun use-package-handler/:bind* (name keyword arg rest state)
|
||||
(use-package-handler/:bind name keyword arg rest state 'bind-keys*))
|
||||
|
|
@ -1096,7 +1144,8 @@ deferred until the prefix key sequence is pressed."
|
|||
#'(lambda ()
|
||||
(interactive)
|
||||
(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-process-keywords name
|
||||
(use-package-sort-keywords
|
||||
|
|
@ -1117,23 +1166,27 @@ deferred until the prefix key sequence is pressed."
|
|||
(use-package-as-one (symbol-name keyword) args
|
||||
(apply-partially #'use-package-normalize-pairs
|
||||
#'use-package-regex-p
|
||||
(lambda (m) (and (not (null m)) (symbolp m)))
|
||||
#'(lambda (v) (use-package--recognize-function v #'null))
|
||||
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."
|
||||
(let* (commands
|
||||
(form (mapcar #'(lambda (thing)
|
||||
(push (cdr thing) commands)
|
||||
(setcar thing
|
||||
(use-package-normalize-regex (car thing)))
|
||||
`(add-to-list ',alist ',thing)) arg)))
|
||||
(cl-destructuring-bind (nargs . commands)
|
||||
(use-package--normalize-commands args)
|
||||
(let ((form
|
||||
(mapcar
|
||||
#'(lambda (thing)
|
||||
`(add-to-list
|
||||
',alist
|
||||
',(cons (use-package-normalize-regex (car thing))
|
||||
(cdr thing))))
|
||||
nargs)))
|
||||
(use-package-concat
|
||||
(use-package-process-keywords name
|
||||
(use-package-sort-keywords
|
||||
(use-package-plist-maybe-put rest :defer t))
|
||||
(use-package-plist-append state :commands commands))
|
||||
`((ignore ,@form)))))
|
||||
`((ignore ,@form))))))
|
||||
|
||||
(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
|
||||
;; `:defer' was a number.
|
||||
(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
|
||||
;; keep the byte-compiler happy.
|
||||
(apply
|
||||
#'nconc
|
||||
(mapcar
|
||||
(cl-mapcan
|
||||
#'(lambda (command)
|
||||
(when (not (stringp command))
|
||||
(when (symbolp command)
|
||||
(append
|
||||
`((unless (fboundp ',command)
|
||||
;; Here we are checking the marker value set in
|
||||
;; `use-package-handler/:ensure' to see if deferred
|
||||
;; installation is actually happening. See
|
||||
;; `use-package-handler/:defer-install' for more
|
||||
;; information.
|
||||
;; `use-package-handler/:defer-install' for more information.
|
||||
,(if (eq (plist-get state :defer-install) :ensure)
|
||||
(use-package--autoload-with-deferred-install
|
||||
command name)
|
||||
(use-package--autoload-with-deferred-install command name)
|
||||
`(autoload #',command ,name-string nil t))))
|
||||
(when (bound-and-true-p byte-compile-current-file)
|
||||
`((eval-when-compile
|
||||
(declare-function ,command ,name-string)))))))
|
||||
(delete-dups (plist-get state :commands))))
|
||||
(delete-dups (plist-get state :commands)))
|
||||
|
||||
body)))
|
||||
|
||||
|
|
@ -1293,11 +1342,10 @@ deferred until the prefix key sequence is pressed."
|
|||
|
||||
(defalias 'use-package-normalize/:after 'use-package-normalize-recursive-symlist)
|
||||
|
||||
(defun use-package-require-after-load
|
||||
(features)
|
||||
(defun use-package-require-after-load (features)
|
||||
"Return form for after any of FEATURES require NAME."
|
||||
(pcase features
|
||||
((and (pred symbolp) feat)
|
||||
((and (pred use-package--non-nil-symbolp) feat)
|
||||
`(lambda (body)
|
||||
(list 'eval-after-load (list 'quote ',feat)
|
||||
(list 'quote body))))
|
||||
|
|
@ -1418,27 +1466,27 @@ deferred until the prefix key sequence is pressed."
|
|||
(defun use-package-normalize/:hook (name keyword args)
|
||||
(use-package-as-one (symbol-name keyword) args
|
||||
(lambda (label arg)
|
||||
(unless (or (symbolp arg) (consp arg))
|
||||
(unless (or (use-package--non-nil-symbolp arg) (consp arg))
|
||||
(use-package-error
|
||||
(concat label " a <symbol> or (<symbol or list of symbols> . <symbol or function>)"
|
||||
" or list of these")))
|
||||
(use-package-normalize-pairs
|
||||
#'(lambda (k)
|
||||
(or (symbolp k)
|
||||
(and (listp k)
|
||||
(listp (cdr k))
|
||||
(cl-every #'symbolp k))))
|
||||
#'(lambda (v)
|
||||
(or (symbolp v) (functionp v)))
|
||||
(or (use-package--non-nil-symbolp k)
|
||||
(and k (let ((every t))
|
||||
(while (and every k)
|
||||
(if (and (consp k)
|
||||
(use-package--non-nil-symbolp (car k)))
|
||||
(setq k (cdr k))
|
||||
(setq every nil)))
|
||||
every))))
|
||||
#'use-package--recognize-function
|
||||
name label arg))))
|
||||
|
||||
(defun use-package-handler/:hook (name keyword args rest state)
|
||||
"Generate use-package custom keyword code."
|
||||
(let ((commands (let (funs)
|
||||
(dolist (def args)
|
||||
(if (symbolp (cdr def))
|
||||
(setq funs (cons (cdr def) funs))))
|
||||
(nreverse funs))))
|
||||
(cl-destructuring-bind (nargs . commands)
|
||||
(use-package--normalize-commands args)
|
||||
(use-package-concat
|
||||
(use-package-process-keywords name
|
||||
(if commands
|
||||
|
|
@ -1456,7 +1504,8 @@ deferred until the prefix key sequence is pressed."
|
|||
#'(lambda (sym)
|
||||
`(add-hook (quote ,(intern (format "%s-hook" sym)))
|
||||
(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
|
||||
(concat label " a (<symbol> <value> [comment])"
|
||||
" or list of these")))
|
||||
(if (symbolp (car arg))
|
||||
(if (use-package--non-nil-symbolp (car arg))
|
||||
(list arg)
|
||||
arg))))
|
||||
|
||||
|
|
@ -1530,7 +1579,7 @@ deferred until the prefix key sequence is pressed."
|
|||
(cond
|
||||
((not arg)
|
||||
(list (use-package-as-mode name)))
|
||||
((symbolp arg)
|
||||
((use-package--non-nil-symbolp arg)
|
||||
(list arg))
|
||||
((stringp 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))
|
||||
;; Handle likely common mistake.
|
||||
(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))
|
||||
((= (length args) 2)
|
||||
`(,(nth 0 args) ,(nth 1 args) ,name))
|
||||
|
|
@ -1584,7 +1634,7 @@ deferred until the prefix key sequence is pressed."
|
|||
(cond ((null args)
|
||||
`((,(use-package-as-mode name) nil ,name)))
|
||||
((and (= (length args) 1)
|
||||
(symbolp (car args)))
|
||||
(use-package--non-nil-symbolp (car args)))
|
||||
`((,(car args) nil ,name)))
|
||||
((and (= (length args) 1)
|
||||
(stringp (car args)))
|
||||
|
|
@ -1599,7 +1649,9 @@ deferred until the prefix key sequence is pressed."
|
|||
`((,(car args) ,@(cdr (nth 1 args)) ,name)))
|
||||
(t (mapcar
|
||||
(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)
|
||||
(let ((body (use-package-process-keywords name rest state)))
|
||||
|
|
|
|||
|
|
@ -84,6 +84,20 @@
|
|||
(should (equal (use-package-normalize-diminish 'foopkg :diminish '(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:
|
||||
;; indent-tabs-mode: nil
|
||||
;; no-byte-compile: t
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue