@map: fix no key-bindings after byte-compiling

This commit is contained in:
Henrik Lissner 2017-02-13 04:44:54 -05:00
parent c845a47ecf
commit 2d0b2d9a3f

View file

@ -193,103 +193,99 @@ Example
(:when IS-MAC (:when IS-MAC
:n \"M-s\" 'some-fn :n \"M-s\" 'some-fn
:i \"M-o\" (lambda (interactive) (message \"Hi\"))))" :i \"M-o\" (lambda (interactive) (message \"Hi\"))))"
(unless noninteractive (let ((keymaps (if (boundp 'keymaps) keymaps))
(let ((keymaps (if (boundp 'keymaps) keymaps)) (prefix (if (boundp 'prefix) prefix))
(prefix (if (boundp 'prefix) prefix)) (state-map '(("n" . normal)
(state-map '(("n" . normal) ("v" . visual)
("v" . visual) ("i" . insert)
("i" . insert) ("e" . emacs)
("e" . emacs) ("o" . operator)
("o" . operator) ("m" . motion)
("m" . motion) ("r" . replace)))
("r" . replace))) local key def states forms)
local key def states forms) (while rest
(while rest (setq key (pop rest))
(setq key (pop rest)) (cond
(cond ;; it's a sub expr
;; it's a sub expr ((listp key)
((listp key) (push (macroexpand `(@map ,@key)) forms))
(push (macroexpand `(@map ,@key)) forms))
;; it's a flag ;; it's a flag
((keywordp key) ((keywordp key)
(when (memq key '(:leader :localleader)) (when (memq key '(:leader :localleader))
(if (not (featurep '+evil)) (cond ((eq key :leader)
(setq rest nil (push '+evil-leader rest))
key :ignore) ((eq key :localleader)
(cond ((eq key :leader) (push '+evil-localleader rest)))
(push '+evil-leader rest)) (setq key :prefix))
((eq key :localleader) (pcase key
(push '+evil-localleader rest))) (:ignore)
(setq key :prefix))) (:prefix
(pcase key (let ((def (pop rest)))
(:ignore) (setq prefix
(:prefix (if (or (symbolp def) (listp def))
(let ((def (pop rest))) `(vconcat ,prefix (if (stringp ,def) (kbd ,def) ,def))
(setq prefix `(vconcat ,prefix ,(if (stringp def) (kbd def) def))))))
(if (or (symbolp def) (listp def)) (:map (setq keymaps (-list (pop rest))))
`(vconcat ,prefix (if (stringp ,def) (kbd ,def) ,def)) (:after (prog1 `((@after ,(pop rest) ,(macroexpand `(@map ,@rest)))) (setq rest '())))
`(vconcat ,prefix ,(if (stringp def) (kbd def) def)))))) (:when (prog1 `((if ,(pop rest) ,(macroexpand `(@map ,@rest)))) (setq rest '())))
(:map (setq keymaps (-list (pop rest)))) (:unless (prog1 `((if (not ,(pop rest)) ,(macroexpand `(@map ,@rest)))) (setq rest '())))
(:after (prog1 `((@after ,(pop rest) ,(macroexpand `(@map ,@rest)))) (setq rest '()))) (otherwise ; might be a state prefix
(:when (prog1 `((if ,(pop rest) ,(macroexpand `(@map ,@rest)))) (setq rest '()))) (mapc (lambda (letter)
(:unless (prog1 `((if (not ,(pop rest)) ,(macroexpand `(@map ,@rest)))) (setq rest '()))) (cond ((assoc letter state-map)
(otherwise ; might be a state prefix (push (cdr (assoc letter state-map)) states))
(mapc (lambda (letter) ((string= letter "L")
(cond ((assoc letter state-map) (setq local t))
(push (cdr (assoc letter state-map)) states)) (t (user-error "Invalid mode prefix %s in key %s" letter key))))
((string= letter "L") (split-string (substring (symbol-name key) 1) "" t))
(setq local t)) (unless states
(t (user-error "Invalid mode prefix %s in key %s" letter key)))) (user-error "Unrecognized keyword %s" key))
(split-string (substring (symbol-name key) 1) "" t)) (when local
(unless states (cond ((= (length states) 0)
(user-error "Unrecognized keyword %s" key)) (user-error "local keybinding for %s must accompany another state" key))
(when local ((> (length keymaps) 0)
(cond ((= (length states) 0) (user-error "local keybinding for %s cannot accompany a keymap" key)))))))
(user-error "local keybinding for %s must accompany another state" key))
((> (length keymaps) 0)
(user-error "local keybinding for %s cannot accompany a keymap" key)))))))
;; It's a key-def pair ;; It's a key-def pair
((or (stringp key) ((or (stringp key)
(characterp key) (characterp key)
(vectorp key)) (vectorp key))
(unwind-protect (unwind-protect
(catch 'skip (catch 'skip
(when (stringp key) (when (stringp key)
(setq key (kbd key))) (setq key (kbd key)))
(when prefix (when prefix
(setq key (append prefix (list key)))) (setq key (append prefix (list key))))
(unless (> (length rest) 0) (unless (> (length rest) 0)
(user-error "Map has no definition for %s" key)) (user-error "Map has no definition for %s" key))
(setq def (pop rest)) (setq def (pop rest))
(push (cond ((and keymaps states) (push (cond ((and keymaps states)
(unless (featurep 'evil) (unless (featurep 'evil)
(throw 'skip 'evil)) (throw 'skip 'evil))
`(progn `(progn
,@(mapcar (lambda (keymap) `(evil-define-key* ',states ,keymap ,key ,def)) ,@(mapcar (lambda (keymap) `(evil-define-key* ',states ,keymap ,key ,def))
keymaps))) keymaps)))
(keymaps (keymaps
`(progn `(progn
,@(mapcar (lambda (keymap) `(define-key ,keymap ,key ,def)) ,@(mapcar (lambda (keymap) `(define-key ,keymap ,key ,def))
keymaps))) keymaps)))
(states (states
(unless (featurep 'evil) (unless (featurep 'evil)
(throw 'skip 'evil)) (throw 'skip 'evil))
`(progn `(progn
,@(mapcar (lambda (state) ,@(mapcar (lambda (state)
`(define-key `(define-key
,(intern (format "evil-%s-state-%smap" state (if local "local-" ""))) ,(intern (format "evil-%s-state-%smap" state (if local "local-" "")))
,key ,def)) ,key ,def))
states))) states)))
(t `(,(if local 'local-set-key 'global-set-key) (t `(,(if local 'local-set-key 'global-set-key)
,key ,def))) ,key ,def)))
forms)) forms))
(setq states '() (setq states '()
local nil))) local nil)))
(t (user-error "Invalid key %s" key)))) (t (user-error "Invalid key %s" key))))
`(progn ,@(reverse forms))))) `(progn ,@(reverse forms))))
(provide 'core-lib) (provide 'core-lib)
;;; core-lib.el ends here ;;; core-lib.el ends here