branch: externals/embark
commit 273261b717fbc12ff8e46392a4ce813158877fa2
Author: Omar Antolín <omar.anto...@gmail.com>
Commit: Omar Antolín <omar.anto...@gmail.com>
Generalize embark-keymap-alist to allow lists of keymaps
---
embark-org.el | 28 +++++++---------------
embark.el | 77 ++++++++++++++++++++++++++++++++++-------------------------
2 files changed, 53 insertions(+), 52 deletions(-)
diff --git a/embark-org.el b/embark-org.el
index 63778b7f5f..ee532e67aa 100644
--- a/embark-org.el
+++ b/embark-org.el
@@ -289,15 +289,6 @@ also the whole target.")
("'" org-insert-link)
("w" 'embark-org-copy-map))
-(defmacro embark-org--define-link-keymap (type)
- "Define a keymap for Org link of given TYPE.
-The keymap will inherit from `embark-org-link-map' and from
-`embark-TYPE-map' in that order."
- `(defvar ,(intern (format "embark-org-%s-link-map" type))
- (make-composed-keymap embark-org-link-map
- ,(intern (format "embark-%s-map" type)))
- ,(format "Keymap for Embark actions on Org %s links" type)))
-
;; The reason for this is left as an exercise to the reader.
;; Solution: Na ryvfc gnetrg znl cebzcg gur hfre sbe fbzrguvat!
(push 'embark--ignore-target
@@ -306,17 +297,16 @@ The keymap will inherit from `embark-org-link-map' and
from
(push 'embark--ignore-target
(alist-get 'org-insert-link embark-target-injection-hooks))
-(embark-org--define-link-keymap url)
-(embark-org--define-link-keymap file)
-(embark-org--define-link-keymap email)
-(embark-org--define-link-keymap expression)
-
-(add-to-list 'embark-keymap-alist '(org-link . embark-org-link-map))
-(add-to-list 'embark-keymap-alist '(org-url-link . embark-org-url-link-map))
-(add-to-list 'embark-keymap-alist '(org-email-link .
embark-org-email-link-map))
-(add-to-list 'embark-keymap-alist '(org-file-link . embark-org-file-link-map))
(add-to-list 'embark-keymap-alist
- '(org-expression-link . embark-org-expression-link-map))
+ '(org-link embark-org-link-map))
+(add-to-list 'embark-keymap-alist
+ '(org-url-link embark-org-link-map embark-url-map))
+(add-to-list 'embark-keymap-alist
+ '(org-email-link embark-org-link-map embark-email-map))
+(add-to-list 'embark-keymap-alist
+ '(org-file-link embark-org-link-map embark-file-map))
+(add-to-list 'embark-keymap-alist
+ '(org-expression-link embark-org-link-map embark-expression-map))
;;; Source blocks and babel calls
diff --git a/embark.el b/embark.el
index bab357c81d..e8c9d9c85c 100644
--- a/embark.el
+++ b/embark.el
@@ -122,35 +122,38 @@
:group 'minibuffer)
(defcustom embark-keymap-alist
- `((file . embark-file-map)
- (library . embark-library-map)
- (environment-variables . embark-file-map) ; they come up in file completion
- (url . embark-url-map)
- (email . embark-email-map)
- (buffer . embark-buffer-map)
- (tab . embark-tab-map)
- (expression . embark-expression-map)
- (identifier . embark-identifier-map)
- (,'defun . embark-defun-map) ;; Avoid package-lint warning
- (symbol . embark-symbol-map)
- (face . embark-face-map)
- (command . embark-command-map)
- (variable . embark-variable-map)
- (function . embark-function-map)
- (minor-mode . embark-command-map)
- (unicode-name . embark-unicode-name-map)
- (package . embark-package-map)
- (bookmark . embark-bookmark-map)
- (region . embark-region-map)
- (sentence . embark-sentence-map)
- (paragraph . embark-paragraph-map)
- (kill-ring . embark-kill-ring-map)
- (heading . embark-heading-map)
- (t . embark-general-map))
+ '((file embark-file-map)
+ (library embark-library-map)
+ (environment-variables embark-file-map) ; they come up in file completion
+ (url embark-url-map)
+ (email embark-email-map)
+ (buffer embark-buffer-map)
+ (tab embark-tab-map)
+ (expression embark-expression-map)
+ (identifier embark-identifier-map)
+ (defun embark-defun-map)
+ (symbol embark-symbol-map)
+ (face embark-face-map)
+ (command embark-command-map)
+ (variable embark-variable-map)
+ (function embark-function-map)
+ (minor-mode embark-command-map)
+ (unicode-name embark-unicode-name-map)
+ (package embark-package-map)
+ (bookmark embark-bookmark-map)
+ (region embark-region-map)
+ (sentence embark-sentence-map)
+ (paragraph embark-paragraph-map)
+ (kill-ring embark-kill-ring-map)
+ (heading embark-heading-map)
+ (t embark-general-map))
"Alist of action types and corresponding keymaps.
-For any type not listed here, `embark-act' will use
-`embark-general-map'."
- :type '(alist :key-type symbol :value-type variable))
+The special key `t' is associated with the default keymap to use.
+Each value can be either a single symbol whose value is a keymap,
+or a list of such symbols."
+ :type '(alist :key-type (symbol :tag "Target type")
+ :value-type (choice (variable :tag "Keymap")
+ (repeat :tag "Keymaps" variable))))
(defcustom embark-target-finders
'(embark-target-top-minibuffer-completion
@@ -976,6 +979,17 @@ their own target finder. See for example
"Return the key to use for `embark-cycle'."
(or embark-cycle-key (car (where-is-internal #'embark-act))))
+(defun embark--raw-action-keymap (type)
+ "Return raw action map for targets of given TYPE.
+This does not take into account the default action, help key or
+cycling bindings, just what's registered in
+`embark-keymap-alist'."
+ (make-composed-keymap
+ (mapcar #'symbol-value
+ (let ((actions (or (alist-get type embark-keymap-alist)
+ (alist-get t embark-keymap-alist))))
+ (if (consp actions) actions (list actions))))))
+
(defun embark--action-keymap (type cycle)
"Return action keymap for targets of given TYPE.
If CYCLE is non-nil bind `embark-cycle'."
@@ -988,8 +1002,7 @@ If CYCLE is non-nil bind `embark-cycle'."
(when embark-help-key
(define-key map embark-help-key #'embark-keymap-help))
map)
- (symbol-value (or (alist-get type embark-keymap-alist)
- (alist-get t embark-keymap-alist)))))
+ (embark--raw-action-keymap type)))
(defun embark--truncate-target (target)
"Truncate TARGET string."
@@ -1986,9 +1999,7 @@ keymap for the given type."
(alist-get type embark-default-action-overrides)
(alist-get t embark-default-action-overrides)
embark--command
- (lookup-key (symbol-value (or (alist-get type embark-keymap-alist)
- (alist-get t embark-keymap-alist)))
- (kbd "RET"))))
+ (lookup-key (embark--raw-action-keymap type) (kbd "RET"))))
(defun embark--rotate (list k)
"Rotate LIST by K elements and return the rotated list."
