emenel/doomemacs
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity

core-lib: refactor map! (and disable it when noninteractive)

Browse source
This commit is contained in:
Henrik Lissner 2017-01-28 02:05:05 -05:00
parent fb53c8fda7
commit 02fef2fded
1 changed files with 77 additions and 77 deletions
Download patch file Download diff file Expand all files Collapse all files

154
core/core-lib.el
View file

@ -148,8 +148,8 @@ Example
:n \"M-s\" 'some-fn :n \"M-s\" 'some-fn
:i \"M-o\" (lambda (interactive) (message \"Hi\"))))" :i \"M-o\" (lambda (interactive) (message \"Hi\"))))"
(let ((keymaps (if (boundp 'keymaps) keymaps)) (let ((keymaps (if (boundp 'keymaps) keymaps))
(defer (if (boundp 'defer) defer)) (defer (if (boundp 'defer) defer))
(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)
@ -160,84 +160,84 @@ Example
local key def states forms) local key def states forms)
(while rest (while rest
(setq key (pop rest)) (setq key (pop rest))
(push (cond
(reverse ;; it's a sub expr
(cond ((listp key)
;; it's a sub expr (push (macroexpand `(map! ,@key)) forms))
((listp key)
`(,(macroexpand `(map! ,@key))))
;; it's a flag ;; it's a flag
((keywordp key) ((keywordp key)
(when (cond ((eq key :leader) (when (cond ((eq key :leader)
(push doom-evil-leader rest)) (push doom-evil-leader rest))
((eq key :localleader) ((eq key :localleader)
(push doom-evil-localleader rest))) (push doom-evil-localleader rest)))
(setq key :prefix)) (setq key :prefix))
(pcase key (pcase key
(:prefix (setq prefix (concat prefix (kbd (pop rest)))) nil) (:prefix (setq prefix (concat prefix (kbd (pop rest)))))
(:map (setq keymaps (-list (pop rest))) nil) (:map (setq keymaps (-list (pop rest))))
(:map* (setq defer t keymaps (-list (pop rest))) nil) (:map* (setq defer t keymaps (-list (pop rest))))
(:unset `(,(macroexpand `(map! ,(kbd (pop rest)) nil)))) (:unset `(,(macroexpand `(map! ,(kbd (pop rest))))))
(:after (prog1 `((after! ,(pop rest) ,(macroexpand `(map! ,@rest)))) (setq rest '()))) (:after (prog1 `((after! ,(pop rest) ,(macroexpand `(map! ,@rest)))) (setq rest '())))
(:when (prog1 `((if ,(pop rest) ,(macroexpand `(map! ,@rest)))) (setq rest '()))) (:when (prog1 `((if ,(pop rest) ,(macroexpand `(map! ,@rest)))) (setq rest '())))
(:unless (prog1 `((if (not ,(pop rest)) ,(macroexpand `(map! ,@rest)))) (setq rest '()))) (:unless (prog1 `((if (not ,(pop rest)) ,(macroexpand `(map! ,@rest)))) (setq rest '())))
(otherwise ; might be a state prefix (otherwise ; might be a state prefix
(mapc (lambda (letter) (mapc (lambda (letter)
(cond ((assoc letter state-map) (cond ((assoc letter state-map)
(push (cdr (assoc letter state-map)) states)) (push (cdr (assoc letter state-map)) states))
((string= letter "L") ((string= letter "L")
(setq local t)) (setq local t))
(t (user-error "Invalid mode prefix %s in key %s" letter key)))) (t (user-error "Invalid mode prefix %s in key %s" letter key))))
(split-string (substring (symbol-name key) 1) "" t)) (split-string (substring (symbol-name key) 1) "" t))
(unless states (unless states
(user-error "Unrecognized keyword %s" key)) (user-error "Unrecognized keyword %s" key))
(when (assoc "L" states) (when (assoc "L" states)
(cond ((= (length states) 1) (cond ((= (length states) 1)
(user-error "local keybinding for %s must accompany another state" key)) (user-error "local keybinding for %s must accompany another state" key))
((> (length keymaps) 0) ((> (length keymaps) 0)
(user-error "local keybinding for %s cannot accompany a keymap" key)))) (user-error "local keybinding for %s cannot accompany a keymap" key)))))))
nil)))
;; 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))
(when (stringp key) (when (stringp key)
(setq key (kbd key))) (setq key (kbd key)))
(when prefix (when prefix
(setq key (cond ((vectorp key) (vconcat prefix key)) (setq key (cond ((vectorp key) (vconcat prefix key))
(t (concat prefix key))))) (t (concat prefix 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))
(let (out-forms) (push
(cond ((and keymaps states) (cond ((and keymaps states)
(mapc (lambda (keymap) (macroexp-progn
(push `(,(if defer 'evil-define-key 'evil-define-key*) (mapcar (lambda (keymap)
',states ,keymap ,key ,def) `(,(if defer 'evil-define-key 'evil-define-key*)
out-forms)) ',states ,keymap ,key ,def))
keymaps)) keymaps)))
(keymaps (keymaps
(mapc (lambda (keymap) (push `(define-key ,keymap ,key ,def) out-forms)) (macroexp-progn
keymaps)) (mapcar (lambda (keymap)
(states `(define-key ,keymap ,key ,def))
(mapc (lambda (state) keymaps)))
(push `(define-key (states
(evil-state-property ',state ,(if local :local-keymap :keymap) t) (macroexp-progn
,key ,def) (mapcar (lambda (state)
out-forms)) `(define-key
states)) (evil-state-property ',state ,(if local :local-keymap :keymap) t)
(t (push `(,(if local 'local-set-key 'global-set-key) ,key ,def))
,key ,def) states)))
out-forms))) (t `(,(if local 'local-set-key 'global-set-key)
(setq states '() ,key ,def)))
local nil) forms)
out-forms)) (setq states '()
local nil))
(t (user-error "Invalid key %s" key)))) (t (user-error "Invalid key %s" key))))
forms)) (macroexp-progn (reverse forms))))
`(progn ,@(apply #'nconc (delete nil (delete (list nil) (reverse forms)))))))
(when noninteractive
(defmacro map! (&rest rest)))
(provide 'core-lib) (provide 'core-lib)
;;; core-lib.el ends here ;;; core-lib.el ends here