[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[elpa] 66/117: Allow keymaps to be copied before modifying them
From: |
Matthew Fidler |
Subject: |
[elpa] 66/117: Allow keymaps to be copied before modifying them |
Date: |
Fri, 25 Jul 2014 13:24:18 +0000 |
mlf176f2 pushed a commit to branch externals/ergoemacs-mode
in repository elpa.
commit d7195676d7ff235b58d29ea13ad5a16941921f68
Author: Matthew L. Fidler <address@hidden>
Date: Fri Jul 18 10:03:34 2014 -0500
Allow keymaps to be copied before modifying them
---
ergoemacs-theme-engine.el | 126 +++++++++++++++++++++++++++++++++++----------
1 files changed, 98 insertions(+), 28 deletions(-)
diff --git a/ergoemacs-theme-engine.el b/ergoemacs-theme-engine.el
index 482b770..2ae3f71 100644
--- a/ergoemacs-theme-engine.el
+++ b/ergoemacs-theme-engine.el
@@ -252,6 +252,8 @@
:type boolean)
(run-hook :initarg :run-hook
:type symbol)
+ (copy-keymap :initarg :copy-keymap
+ :type symbol)
(deferred-keys :initarg :deferred-keys
:initform '()
:type list))
@@ -319,6 +321,7 @@ The elements of LIST are not copied, just the list
structure itself."
always
first
run-hook
+ copy-keymap
modify-map
deferred-keys
full-map) obj
@@ -602,6 +605,8 @@ DEF is anything that can be a key's definition:
:type boolean)
(run-hook :initarg :run-hook
:type symbol)
+ (copy-keymap :initarg :copy-keymap
+ :type symbol)
(always :initarg :always
:initform nil
:type boolean))
@@ -748,6 +753,8 @@ Optionally use DESC when another description isn't found in
`ergoemacs-function-
:type boolean)
(run-hook :initarg :run-hook
:type symbol)
+ (copy-keymap :initarg :copy-keymap
+ :type symbol)
(fixed :initarg :fixed
:type ergoemacs-fixed-map)
(keymap-hash :initarg :keymap-hash
@@ -777,6 +784,8 @@ Optionally use DESC when another description isn't found in
`ergoemacs-function-
(oset fixed hook (oref obj hook)))
(when (slot-boundp obj 'run-hook)
(oset fixed run-hook (oref obj run-hook)))
+ (when (slot-boundp obj 'copy-keymap)
+ (oset fixed copy-keymap (oref obj copy-keymap)))
(oset obj fixed fixed)))
(unless (slot-boundp obj 'variable)
(let ((var (ergoemacs-variable-map
@@ -792,6 +801,8 @@ Optionally use DESC when another description isn't found in
`ergoemacs-function-
(oset var hook (oref obj hook)))
(when (slot-boundp obj 'run-hook)
(oset var run-hook (oref obj run-hook)))
+ (when (slot-boundp obj 'copy-keymap)
+ (oset var copy-keymap (oref obj copy-keymap)))
(oset obj variable var))))
(defmethod ergoemacs-define-map ((obj ergoemacs-composite-map) key def
&optional no-unbind)
@@ -889,6 +900,8 @@ Assumes maps are orthogonal."
(oset ret hook (oref obj hook)))
(when (slot-boundp obj 'run-hook)
(oset ret run-hook (oref obj run-hook)))
+ (when (slot-boundp obj 'copy-keymap)
+ (oset ret copy-keymap (oref obj copy-keymap)))
(puthash ilay ret keymap-hash)
(oset obj keymap-hash keymap-hash))
(setq ret (clone ret (ergoemacs-object-name-string obj))) ;; Reset name
@@ -978,6 +991,7 @@ Assumes maps are orthogonal."
(defvar ergoemacs-theme-component-maps--always nil)
(defvar ergoemacs-theme-component-maps--first nil)
(defvar ergoemacs-theme-component-maps--run-hook nil)
+(defvar ergoemacs-theme-component-maps--copy-keymap nil)
(defvar ergoemacs-theme-component-maps--full-map nil)
(defvar ergoemacs-theme-component-maps--modify-map nil)
(defvar ergoemacs-theme-component-maps--global-map nil)
@@ -1005,6 +1019,8 @@ Assumes maps are orthogonal."
:modify-map ergoemacs-theme-component-maps--modify-map))
(when ergoemacs-theme-component-maps--run-hook
(oset ret run-hook ergoemacs-theme-component-maps--run-hook))
+ (when ergoemacs-theme-component-maps--copy-keymap
+ (oset ret copy-keymap ergoemacs-theme-component-maps--copy-keymap))
(if ergoemacs-theme-component-maps--hook
(oset ret hook ergoemacs-theme-component-maps--hook)
(oset ret hook (intern (save-match-data (replace-regexp-in-string
"-map.*\\'" "-hook" (symbol-name keymap))))))
@@ -1086,6 +1102,27 @@ Assumes maps are orthogonal."
maps))
ret)))
+(defmethod ergoemacs-copy-keymap-symbol ((obj ergoemacs-theme-component-maps)
+ hook map-name)
+ "Get the map that should be copied into the MAP-NAME before the HOOK and
MAP-NAME combination."
+ (ergoemacs-theme-component-maps--ini obj)
+ (let (ret)
+ (with-slots (maps) obj
+ (catch 'found-hook
+ (maphash
+ (lambda (map-n map-obj)
+ (setq ret
+ (or ret
+ (and (eq map-name map-n)
+ (slot-boundp map-obj 'hook)
+ (eq (oref map-obj hook) hook)
+ (slot-boundp map-obj 'copy-keymap)
+ (oref map-obj copy-keymap))))
+ (when ret
+ (throw 'found-hook t)))
+ maps))
+ ret)))
+
(defmethod ergoemacs-get-hooks ((obj ergoemacs-theme-component-maps) &optional
match ret keymaps)
(ergoemacs-theme-component-maps--ini obj)
(with-slots (maps hooks) obj
@@ -1183,6 +1220,21 @@ Assumes maps are orthogonal."
(puthash (list hook map-name 'run-hook-fn) final hooks))
final)))
+(defmethod ergoemacs-copy-keymap-symbol ((obj
ergoemacs-theme-component-map-list)
+ hook map-name)
+ "Get the map that should be copied into the MAP-NAME before the HOOK and
MAP-NAME combination."
+ (with-slots (map-list hooks) obj
+ (let* ((final (gethash (list hook map-name 'copy-keymap-symbol) hooks)))
+ (unless final
+ (catch 'copy-keymap-p
+ (dolist (map map-list)
+ (when (ergoemacs-theme-component-maps-p map)
+ (setq final (ergoemacs-copy-keymap-symbol map hook map-name))
+ (when final
+ (throw 'copy-keymap-p t)))))
+ (puthash (list hook map-name 'copy-keymap-symbol) final hooks))
+ final)))
+
(defmethod ergoemacs-get-hooks ((obj ergoemacs-theme-component-map-list)
&optional match keymaps)
(with-slots (map-list hooks) obj
(let* ((final (gethash (list match keymaps) hooks))
@@ -1381,6 +1433,7 @@ If it is not a composed KEYMAP, return the keymap as is."
(defvar ergoemacs-shortcut-emulation-mode-map-alist)
(defvar ergoemacs-no-shortcut-emulation-mode-map-alist)
(defvar ergoemacs-mode)
+(defvar ergoemacs-theme--hook-running nil)
(defmethod ergoemacs-theme-obj-install ((obj
ergoemacs-theme-component-map-list) &optional remove-p)
(with-slots (read-map
map
@@ -1423,34 +1476,43 @@ If it is not a composed KEYMAP, return the keymap as
is."
(fset fn-name
`(lambda() ,(format "Turn on `ergoemacs-mode' for `%s'
during the hook `%s'."
(symbol-name map-name) (symbol-name
hook))
- (dolist (map ergoemacs-first-keymaps)
- (when (eq (car map) ',map-name)
- (dolist (fn (cdr map))
- (unless (eq fn ',fn-name)
- (funcall fn)))))
- ,(when (ergoemacs-run-hook-fn obj hook map-name)
- `(run-hooks ',(ergoemacs-run-hook-fn obj hook
map-name)))
- (message ,(format "Run %s" (symbol-name fn-name)))
- (let ((new-map ',map))
- (ergoemacs-theme--install-shortcuts-list
- ',(reverse shortcut-list) new-map ,map-name
,full-map)
- (dolist (item ',deferred-keys) ; Install deferred
keys now.
- (catch 'found-bound-command
- (dolist (fn (nth 1 item))
- (when (commandp fn t)
- (define-key new-map (nth 0 item) fn)
- (throw 'found-bound-command t)))))
- (setq new-map (ergoemacs-flatten-composed-keymap
(make-composed-keymap new-map ,map-name)))
- ;; Try to modify in place, without any
- ;; copying of keymaps.
- (ergoemacs-flatten-composed-keymap--define-key
new-map ,map-name)
- ,(when (and first (ergoemacs-is-first-p obj hook
map-name))
+ (unless (eq ergoemacs-theme--hook-running ',fn-name)
+ (dolist (map ergoemacs-first-keymaps)
+ (when (eq (car map) ',map-name)
+ (dolist (fn (cdr map))
+ (unless (eq fn ',fn-name)
+ (setq ergoemacs-theme--hook-running
',fn-name)
+ (funcall fn)
+ (setq ergoemacs-theme--hook-running
nil)))))
+ ,(when (ergoemacs-run-hook-fn obj hook map-name)
+ `(progn
+ (setq ergoemacs-theme--hook-running
',fn-name)
+ (run-hooks ',(ergoemacs-run-hook-fn obj
hook map-name))
+ (setq ergoemacs-theme--hook-running nil)))
+ ,(when (ergoemacs-copy-keymap-symbol obj hook
map-name)
`(progn
- (define-key ,map-name [,map-name] 'ignore)
- (remove-hook ',hook ',fn-name)))
- ;; ,(when (eq hook
'iswitchb-minibuffer-setup-hook)
- ;; `(message "%s" (substitute-command-keys
"\\{minibuffer-local-map}")))
- )))
+ ;; (message ,(concat "Copy " (symbol-name
(ergoemacs-copy-keymap-symbol obj hook map-name))))
+ (setq map-name (copy-keymap
,(ergoemacs-copy-keymap-symbol obj hook map-name)))))
+ ;; (message ,(format "Run %s" (symbol-name
fn-name)))
+ (let ((new-map ',map))
+ (ergoemacs-theme--install-shortcuts-list
+ ',(reverse shortcut-list) new-map ,map-name
,full-map)
+ (dolist (item ',deferred-keys) ; Install
deferred keys now.
+ (catch 'found-bound-command
+ (dolist (fn (nth 1 item))
+ (when (commandp fn t)
+ (define-key new-map (nth 0 item) fn)
+ (throw 'found-bound-command t)))))
+ (setq new-map
(ergoemacs-flatten-composed-keymap (make-composed-keymap new-map ,map-name)))
+ ;; Try to modify in place, without any
+ ;; copying of keymaps.
+ (ergoemacs-flatten-composed-keymap--define-key
new-map ,map-name)
+ ,(when (and first (ergoemacs-is-first-p obj
hook map-name))
+ `(progn
+ (define-key ,map-name [,map-name] 'ignore)
+ (remove-hook ',hook ',fn-name)))
+ ,(when (eq hook 'iswitchb-define-mode-map-hook)
+ `(message "%s" (substitute-command-keys
"\\{iswitchb-mode-map}")))))))
(funcall (if remove-p #'remove-hook #'add-hook) hook
fn-name)
(when (and first (not remove-p)
@@ -1719,6 +1781,7 @@ The actual keymap changes are included in
`ergoemacs-emulation-mode-map-alist'."
new-cmd-list
new-modify-map
new-hook
+ new-copy-keymap
new-run-hook
new-full-map
new-always
@@ -1758,6 +1821,8 @@ The actual keymap changes are included in
`ergoemacs-emulation-mode-map-alist'."
(setq new-hook (oref map-obj hook)))
(when (slot-boundp map-obj 'run-hook)
(setq new-run-hook (oref map-obj run-hook)))
+ (when (slot-boundp map-obj 'copy-keymap)
+ (setq new-copy-keymap (oref map-obj copy-keymap)))
(if curr-first
(setq new-shortcut-list shortcut-list
new-shortcut-movement shortcut-movement
@@ -1809,6 +1874,8 @@ The actual keymap changes are included in
`ergoemacs-emulation-mode-map-alist'."
(oset ret hook new-hook))
(when new-run-hook
(oset ret run-hook new-run-hook))
+ (when new-copy-keymap
+ (oset ret copy-keymap new-copy-keymap))
(puthash key ret ergoemacs-theme-component-map-list-fixed-hash)))
ret)))
@@ -1886,7 +1953,9 @@ The actual keymap changes are included in
`ergoemacs-emulation-mode-map-alist'."
(ergoemacs-theme-component-maps--first
(plist-get plist ':first))
(ergoemacs-theme-component-maps--run-hook
- (plist-get plist ':run-hook)))
+ (plist-get plist ':run-hook))
+ (ergoemacs-theme-component-maps--copy-keymap
+ (plist-get plist ':copy-keymap)))
(funcall body)))
;;;###autoload
@@ -1896,6 +1965,7 @@ The actual keymap changes are included in
`ergoemacs-emulation-mode-map-alist'."
(ergoemacs-theme-component-maps--always nil)
(ergoemacs-theme-component-maps--first nil)
(ergoemacs-theme-component-maps--run-hook nil)
+ (ergoemacs-theme-component-maps--copy-keymap nil)
(ergoemacs-theme-component-maps--full-map nil)
(ergoemacs-theme-component-maps--modify-map nil)
(ergoemacs-theme-component-maps--global-map nil)
- [elpa] 46/117: Install ergoemacs-read-default for every major mode, (continued)
- [elpa] 46/117: Install ergoemacs-read-default for every major mode, Matthew Fidler, 2014/07/25
- [elpa] 54/117: Fix menu keybinding preprocessing, Matthew Fidler, 2014/07/25
- [elpa] 57/117: Add first keyword, and use in minibuffer-setup-hook, Matthew Fidler, 2014/07/25
- [elpa] 60/117: Fix byte-compile warning, Matthew Fidler, 2014/07/25
- [elpa] 62/117: Update ergoemacs-mode-line custom description, Matthew Fidler, 2014/07/25
- [elpa] 61/117: Set ergoemacs-mode-line default to t, Matthew Fidler, 2014/07/25
- [elpa] 63/117: Attempt to fix Issue #278, Matthew Fidler, 2014/07/25
- [elpa] 67/117: Fix Issue #278, Matthew Fidler, 2014/07/25
- [elpa] 59/117: Add ergoemacs-mode-line option, Matthew Fidler, 2014/07/25
- [elpa] 64/117: Add run-hook property, Matthew Fidler, 2014/07/25
- [elpa] 66/117: Allow keymaps to be copied before modifying them,
Matthew Fidler <=
- [elpa] 69/117: Fix Issue #279, Matthew Fidler, 2014/07/25
- [elpa] 70/117: Fix unbound keys test, Matthew Fidler, 2014/07/25
- [elpa] 72/117: Add back emacs 23, Matthew Fidler, 2014/07/25
- [elpa] 71/117: Use flat keymaps (start supporting emacs 23?), Matthew Fidler, 2014/07/25
- [elpa] 73/117: Try to make compatible with emacs 23, Matthew Fidler, 2014/07/25
- [elpa] 74/117: Remove debugging for iswitch-buffer, Matthew Fidler, 2014/07/25
- [elpa] 65/117: Allow hooks to be run before modifying keymaps, Matthew Fidler, 2014/07/25
- [elpa] 75/117: Declare some of the package functions to compile cleanly on Emacs 23, Matthew Fidler, 2014/07/25
- [elpa] 76/117: Add toggle component, Matthew Fidler, 2014/07/25
- [elpa] 78/117: Fix visual line support, Matthew Fidler, 2014/07/25