mlf176f2 pushed a commit to branch externals/ergoemacs-mode in repository elpa.
commit a8ed050f801b5f7910068f280dde527a7f0ee39d Author: Matthew L. Fidler <[email protected]> Date: Mon Jun 9 14:03:12 2014 -0500 Add more emulation alists. Less list manipulation --- ergoemacs-functions.el | 13 ++++++ ergoemacs-modal.el | 6 ++- ergoemacs-mode.el | 94 +++++++++++++++----------------------------- ergoemacs-shortcuts.el | 27 ++++++++----- ergoemacs-theme-engine.el | 62 +++++++++++++++++++++--------- 5 files changed, 110 insertions(+), 92 deletions(-) diff --git a/ergoemacs-functions.el b/ergoemacs-functions.el index f12ab77..a4d5df7 100644 --- a/ergoemacs-functions.el +++ b/ergoemacs-functions.el @@ -2083,10 +2083,23 @@ See also `ergoemacs-lookup-word-on-internet'." (insert (format "ergoemacs-mode %s\n" ergoemacs-mode)) (insert (format "ergoemacs-save-variables-state %s\n" ergoemacs-save-variables-state)) (insert (format "emulation-mode-map-alists: %s\n" emulation-mode-map-alists)) + (insert (format "ergoemacs-read-emulation-mode-map-alist: %s\n" + (mapcar + (lambda(x) (nth 0 x)) + ergoemacs-read-emulation-mode-map-alist))) + (insert (format "ergoemacs-modal-emulation-mode-map-alist: %s\n" + (mapcar + (lambda(x) (nth 0 x)) + ergoemacs-modal-emulation-mode-map-alist))) + (insert (format "ergoemacs-repeat-emulation-mode-map-alist: %s\n" + (mapcar + (lambda(x) (nth 0 x)) + ergoemacs-repeat-emulation-mode-map-alist))) (insert (format "ergoemacs-emulation-mode-map-alist: %s\n" (mapcar (lambda(x) (nth 0 x)) ergoemacs-emulation-mode-map-alist))) + (insert (format "minor-mode-map-alist: %s\n" (mapcar (lambda(x) (nth 0 x)) diff --git a/ergoemacs-modal.el b/ergoemacs-modal.el index 0269322..4a65f4c 100644 --- a/ergoemacs-modal.el +++ b/ergoemacs-modal.el @@ -387,7 +387,8 @@ Typically function keys") (make-composed-keymap (list (ergoemacs-local-map type t) (ergoemacs-modal-base-keymap)))) - (ergoemacs-add-emulation) + (setq ergoemacs-modal-emulation-mode-map-alist + `((ergoemacs-modal ,@ergoemacs-modal-keymap))) (set-default 'ergoemacs-modal type) (setq ergoemacs-modal type) (unless ergoemacs-default-cursor @@ -419,7 +420,8 @@ Typically function keys") (make-composed-keymap (list (ergoemacs-local-map type t) (ergoemacs-modal-base-keymap)))) - (ergoemacs-add-emulation) + (setq ergoemacs-modal-emulation-mode-map-alist + `((ergoemacs-modal ,@ergoemacs-modal-keymap))) (set-default 'ergoemacs-modal type) (setq ergoemacs-modal type) (unless ergoemacs-default-cursor diff --git a/ergoemacs-mode.el b/ergoemacs-mode.el index 4636d90..df87470 100644 --- a/ergoemacs-mode.el +++ b/ergoemacs-mode.el @@ -243,59 +243,19 @@ Valid values are: ergoemacs-repeat-keys ergoemacs-read-input-keys (keymap (make-sparse-keymap))) - (mapc - (lambda(key) - (when (= 1 (length key)) - (let ((mods (event-modifiers (elt key 0)))) - (when (memq 'meta mods) - (define-key keymap - (vector - (event-convert-list - (append (delete 'meta mods) - (list (event-basic-type (elt key 0)))))) - `(lambda() (interactive) (ergoemacs-read-key ,(key-description key)))))))) - (append (where-is-internal 'ergoemacs-shortcut-movement) - (where-is-internal 'ergoemacs-shortcut-movement-no-shift-select))) + (dolist (key (append (where-is-internal 'ergoemacs-shortcut-movement) + (where-is-internal 'ergoemacs-shortcut-movement-no-shift-select))) + (when (= 1 (length key)) + (let ((mods (event-modifiers (elt key 0)))) + (when (memq 'meta mods) + (define-key keymap + (vector + (event-convert-list + (append (delete 'meta mods) + (list (event-basic-type (elt key 0)))))) + `(lambda() (interactive) (ergoemacs-read-key ,(key-description key)))))))) keymap)) - -(when (not (fboundp 'set-temporary-overlay-map)) - ;; Backport this function from newer emacs versions - (defun set-temporary-overlay-map (map &optional keep-pred) - "Set a new keymap that will only exist for a short period of time. -The new keymap to use must be given in the MAP variable. When to -remove the keymap depends on user input and KEEP-PRED: - -- if KEEP-PRED is nil (the default), the keymap disappears as - soon as any key is pressed, whether or not the key is in MAP; - -- if KEEP-PRED is t, the keymap disappears as soon as a key *not* - in MAP is pressed; - -- otherwise, KEEP-PRED must be a 0-arguments predicate that will - decide if the keymap should be removed (if predicate returns - nil) or kept (otherwise). The predicate will be called after - each key sequence." - (let* ((clearfunsym (make-symbol "clear-temporary-overlay-map")) - (overlaysym (make-symbol "t")) - (alist (list (cons overlaysym map))) - (clearfun - `(lambda () - (unless ,(cond ((null keep-pred) nil) - ((eq t keep-pred) - `(eq this-command - (lookup-key ',map - (this-command-keys-vector)))) - (t `(funcall ',keep-pred))) - (remove-hook 'pre-command-hook ',clearfunsym) - (setq emulation-mode-map-alists - (delq ',alist emulation-mode-map-alists)))))) - (set overlaysym overlaysym) - (fset clearfunsym clearfun) - (add-hook 'pre-command-hook clearfunsym) - - (push alist emulation-mode-map-alists)))) - (defvar ergoemacs-curr-prefix-arg nil) (defvar ergoemacs-repeat-keys nil) (defvar ergoemacs-shortcut-keys nil) @@ -412,8 +372,26 @@ remove the keymap depends on user input and KEEP-PRED: (defvar ergoemacs-save-variables-actual nil) (defvar ergoemacs-save-variables-state nil) +(defvar ergoemacs-modal-emulation-mode-map-alist nil + "Override keys in `ergoemacs-mode' for `emulation-mode-map-alist'") + +(defvar ergoemacs-repeat-emulation-mode-map-alist nil + "Override keys in `ergoemacs-mode' for `emulation-mode-map-alist'") + +(defvar ergoemacs-read-emulation-mode-map-alist nil + "Override keys in `ergoemacs-mode' for `emulation-mode-map-alist'") + (defvar ergoemacs-emulation-mode-map-alist nil - "Override keys in ergoemacs-mode for `emulation-mode-map-alist'") + "Override keys in `ergoemacs-mode' for `emulation-mode-map-alist'") + +(defun ergoemacs-emulations (&optional remove) + "Add ergoemacs emulations to `emulation-mode-map-alist'. +When REMOVE is true, remove the emulations." + (dolist (hook (reverse '(ergoemacs-modal-emulation-mode-map-alist + ergoemacs-read-emulation-mode-map-alist + ergoemacs-repeat-emulation-mode-map-alist + ergoemacs-emulation-mode-map-alist))) + (funcall (if remove #'remove-hook #'add-hook) #'emulation-mode-map-alists hook))) ;; ErgoEmacs minor mode ;;;###autoload @@ -454,12 +432,7 @@ bindings the keymap is: ;; (if (boundp 'org-CUA-compatible) ;; (setq ergoemacs-org-CUA-compatible nil) ;; (setq ergoemacs-org-CUA-compatible org-CUA-compatible)) - ;; From yasnippet: - ;; Install the direct keymaps in `emulation-mode-map-alists' - ;; (we use `add-hook' even though it's not technically a hook, - ;; but it works). Then define variables named after modes to - ;; index `ergoemacs-emulation-mode-map-alist'. - (add-hook 'emulation-mode-map-alists 'ergoemacs-emulation-mode-map-alist) + (ergoemacs-emulations) ;; Setup keys (setq ergoemacs-shortcut-keymap (make-sparse-keymap)) (ergoemacs-setup-keys t) @@ -722,10 +695,7 @@ This is added to `ergoemacs-emulation-mode-map-alist' while keeping the order co (when (listp keymap-list) (setq small-emulation (append keymap-list small-emulation))) (setq ergoemacs-emulation-mode-map-alist - `((ergoemacs-modal ,@(or ergoemacs-modal-keymap (make-sparse-keymap))) - (ergoemacs-repeat-keys ,@(or ergoemacs-repeat-keymap (make-sparse-keymap))) - (ergoemacs-read-input-keys ,@(or ergoemacs-read-input-keymap (make-sparse-keymap))) - ,@small-emulation + `(,@small-emulation (ergoemacs-shortcut-keys ,@(or ergoemacs-shortcut-keymap (make-sparse-keymap))))))) (defun ergoemacs-shuffle-keys (&optional var keymap keymap-list) diff --git a/ergoemacs-shortcuts.el b/ergoemacs-shortcuts.el index fb4339d..0898a94 100644 --- a/ergoemacs-shortcuts.el +++ b/ergoemacs-shortcuts.el @@ -113,7 +113,7 @@ The global map is ignored, but major/minor modes keymaps are included." (use-global-map old-global-map)))) (defmacro ergoemacs-without-emulation (&rest body) - "Without keys defined at `ergoemacs-emulation-mode-map-alist'. + "Without keys defined at `emulation-mode-map-alists'. Also temporarily remove any changes ergoemacs-mode made to: - `overriding-terminal-local-map' @@ -126,7 +126,7 @@ installing the original keymap above the ergoemacs-mode installed keymap. (overriding-local-map overriding-local-map) lookup tmp-overlay override-text-map) ;; Remove most of ergoemacs-mode's key bindings - (remove-hook 'emulation-mode-map-alists 'ergoemacs-emulation-mode-map-alist) + (ergoemacs-emulations 'remove) (unwind-protect (progn ;; Install override-text-map changes above anything already @@ -136,7 +136,7 @@ installing the original keymap above the ergoemacs-mode installed keymap. (when tmp-overlay (delete-overlay tmp-overlay)) (when ergoemacs-mode - (add-hook 'emulation-mode-map-alists 'ergoemacs-emulation-mode-map-alist))))) + (ergoemacs-emulations))))) (defgroup ergoemacs-read nil "Options for ergoemacs-read-key." @@ -1234,12 +1234,10 @@ argument prompt. (push (concat key-base "-et") key-trials))) (ergoemacs-shortcut-function-binding (nth 0 tmp))))) (when ergoemacs-translate-keys - (mapc - (lambda(trial) - (push trial key-trials) - (setq next-key (ergoemacs-read-key-add-translation next-key trial)) - (push (concat trial "-et") key-trials)) - '(":raw" ":ctl" ":alt" ":alt-ctl" ":raw-shift" ":ctl-shift" ":alt-shift" ":alt-ctl-shift"))) + (dolist (trial '(":raw" ":ctl" ":alt" ":alt-ctl" ":raw-shift" ":ctl-shift" ":alt-shift" ":alt-ctl-shift")) + (push trial key-trials) + (setq next-key (ergoemacs-read-key-add-translation next-key trial)) + (push (concat trial "-et") key-trials))) (setq key-trials (reverse key-trials)) (unless (catch 'ergoemacs-key-trials @@ -1399,6 +1397,14 @@ argument prompt. ergoemacs-mark-active nil)) (setq ergoemacs-describe-key nil)) +(defun ergoemacs-read-key-default (&optional arg) + "The default command for `ergoemacs-mode' read-key. +It sends `this-single-command-keys' to `ergoemacs-read-key' with +no translation listed." + (interactive "^P") + (ergoemacs-read-key + (or ergoemacs-single-command-keys (this-single-command-keys)))) + (defvar ergoemacs-ignored-prefixes '(;; "C-h" "<f1>" @@ -1476,7 +1482,8 @@ Basically, this gets the keys called and passes the arguments to`ergoemacs-read- (defun ergoemacs-install-repeat-keymap (keymap &optional mode-line) "Installs repeat KEYMAP." (setq ergoemacs-repeat-keymap keymap) - (ergoemacs-add-emulation) + (setq ergoemacs-repeat-emulation-mode-map-alist + (list (cons 'ergoemacs-repeat-keys ergoemacs-repeat-keymap))) (setq ergoemacs-repeat-keys t) (when mode-line (ergoemacs-mode-line mode-line))) diff --git a/ergoemacs-theme-engine.el b/ergoemacs-theme-engine.el index 1246e5a..8b9b688 100644 --- a/ergoemacs-theme-engine.el +++ b/ergoemacs-theme-engine.el @@ -219,6 +219,9 @@ a set type." (read-map :initarg :read-map :initform (make-sparse-keymap) :type keymap) + (read-list :initarg :read-list + :initform () + :type list) (shortcut-map :initarg :shortcut-map :initform (make-sparse-keymap) :type keymap) @@ -323,12 +326,12 @@ a set type." (let ((deferred-list deferred-list)) (setq deferred-keys (mapcar - (lambda(x) - (if (equal (nth 0 x) key) - (prog1 (list key deferred-list) - (setq deferred-list nil)) - x)) - deferred-keys)) + (lambda(x) + (if (equal (nth 0 x) key) + (prog1 (list key deferred-list) + (setq deferred-list nil)) + x)) + deferred-keys)) (when deferred-list (push (list key (reverse deferred-list)) deferred-keys)) (oset obj deferred-keys deferred-keys)))) @@ -362,15 +365,15 @@ Optionally use DESC when another description isn't found in `ergoemacs-function- (defmethod ergoemacs-define-map--read-map ((obj ergoemacs-fixed-map) key) "Defines KEY in the OBJ read-key slot if it is a vector over 2. Key sequences starting with `ergoemacs-ignored-prefixes' are not added." - (with-slots (read-map) obj + (with-slots (read-map + read-list) obj (when (< 1 (length key)) (let* ((new-key (substring key 0 1)) (kd (key-description new-key))) (unless (member kd ergoemacs-ignored-prefixes) - (define-key read-map new-key - `(lambda() - (interactive) - (ergoemacs-read-key ,kd 'normal))) + (push new-key read-list) + (oset obj read-list read-list) + (define-key read-map new-key #'ergoemacs-read-key-default) (oset obj read-map read-map)))))) (defgeneric ergoemacs-define-map (obj key def &optional no-unbind) @@ -423,7 +426,9 @@ DEF is anything that can be a key's definition: rm-keys shortcut-movement global-map-p - shortcut-shifted-movement) obj + shortcut-shifted-movement + read-list + read-map) obj (let* ((key-desc (key-description key)) (key-vect (read-kbd-macro key-desc t)) swapped @@ -472,8 +477,10 @@ DEF is anything that can be a key's definition: ;; Normal command (if (memq def '(ergoemacs-ctl-c ergoemacs-ctl-x)) (progn - (define-key shortcut-map key-vect def) - (oset obj shortcut-map shortcut-map)) + (push (list key-vect def) read-list) + (define-key read-map key-vect def) + (oset obj read-map read-map) + (oset obj read-list read-list)) (define-key map key-vect def) (oset obj map map)) (ergoemacs-define-map--cmd-list obj key-desc def)) @@ -730,18 +737,28 @@ Assumes maps are orthogonal." (with-slots (variable object-name fixed modify-map full-map always global-map-p keymap-hash) obj (let* ((lay (or layout ergoemacs-keyboard-layout)) + read (ilay (intern lay)) (ret (gethash ilay keymap-hash)) (fix fixed) map1 map2 var) (unless ret ;; Calculate (setq var (ergoemacs-get-fixed-map variable lay)) + (setq read (copy-keymap (oref fix read-map))) + ;; This way the read-map is not a composite map. + (dolist (key (oref var read-list)) + (cond + ((vectorp key) + (define-key read key #'ergoemacs-read-key-default)) + ((and (listp key) (vectorp (nth 0 key))) + (define-key read (nth 0 key) (nth 1 key))))) (setq ret (ergoemacs-fixed-map lay :global-map-p global-map-p :modify-map modify-map :full-map full-map :always always - :read-map (ergoemacs-get-fixed-map--combine-maps (oref var read-map) (oref fix read-map)) + :read-map read + :read-list (append (oref var read-list) (oref fix read-list)) :shortcut-map (ergoemacs-get-fixed-map--combine-maps (oref var shortcut-map) (oref fix shortcut-map)) :no-shortcut-map (ergoemacs-get-fixed-map--combine-maps (oref var no-shortcut-map) (oref fix no-shortcut-map)) :map (ergoemacs-get-fixed-map--combine-maps (oref var map) (oref fix map)) @@ -1214,6 +1231,7 @@ The actual keymap changes are included in `ergoemacs-emulation-mode-map-alist'." (let ((fixed-maps (mapcar (lambda(map) (and map (ergoemacs-get-fixed-map map keymap layout))) map-list)) new-global-map-p new-read-map + new-read-list new-shortcut-map new-no-shortcut-map new-map @@ -1234,6 +1252,7 @@ The actual keymap changes are included in `ergoemacs-emulation-mode-map-alist'." (when (ergoemacs-fixed-map-p map-obj) (with-slots (global-map-p read-map + read-list shortcut-map no-shortcut-map map @@ -1263,6 +1282,7 @@ The actual keymap changes are included in `ergoemacs-emulation-mode-map-alist'." (setq new-shortcut-list shortcut-list new-shortcut-movement shortcut-movement new-shortcut-shifted-movement shortcut-shifted-movement + new-read-list read-list new-rm-keys rm-keys new-cmd-list cmd-list new-deferred-keys deferred-keys @@ -1275,6 +1295,7 @@ The actual keymap changes are included in `ergoemacs-emulation-mode-map-alist'." new-modify-map (or new-modify-map modify-map) new-full-map (or new-full-map full-map) new-always (or new-always always) + new-read-list (append new-read-list read-list) new-shortcut-list (append new-shortcut-list shortcut-list) new-shortcut-movement (append new-shortcut-movement shortcut-movement) new-shortcut-shifted-movement (append new-shortcut-shifted-movement shortcut-shifted-movement) @@ -1287,6 +1308,7 @@ The actual keymap changes are included in `ergoemacs-emulation-mode-map-alist'." (and (symbolp keymap) (symbol-name keymap)))) "composite") :global-map-p new-global-map-p + :read-list new-read-list :read-map (ergoemacs-get-fixed-map--composite new-read-map) :shortcut-map (ergoemacs-get-fixed-map--composite new-shortcut-map) :no-shortcut-map (ergoemacs-get-fixed-map--composite new-no-shortcut-map) @@ -3626,11 +3648,13 @@ When NO-MESSAGE is true, don't tell the user." (set map-name (copy-keymap orig-map)))))))) ergoemacs-theme-hook-installed)) + + (defun ergoemacs-theme-remove (&optional no-message) "Remove the currently installed theme and reset to emacs keys. When NO-MESSAGE is true, don't tell the user." (ergoemacs-theme-make-hooks ergoemacs-theme 'remove-hooks) - (remove-hook 'emulation-mode-map-alists 'ergoemacs-emulation-mode-map-alist) + (ergoemacs-emulations 'remove) ;;; Restore maps (ergoemacs-theme-restore-maps no-message) (setq ergoemacs-command-shortcuts-hash (make-hash-table :test 'equal) @@ -3746,6 +3770,9 @@ This also: ;; `ergoemacs-read-input-keymap', then `ergoemacs-shortcut-keymap' ;; in `ergoemacs-emulation-mode-map-alist' (ergoemacs-add-emulation) + (add-hook 'emulation-mode-map-alists 'ergoemacs-modal-emulation-mode-map-alist) + (add-hook 'emulation-mode-map-alists 'ergoemacs-repeat-emulation-mode-map-alist) + (add-hook 'emulation-mode-map-alists 'ergoemacs-read-emulation-mode-map-alist) (add-hook 'emulation-mode-map-alists 'ergoemacs-emulation-mode-map-alist) (ergoemacs-theme-make-hooks ergoemacs-theme) (set-default 'ergoemacs-mode t) @@ -3824,8 +3851,7 @@ This also: (ergoemacs-theme-remove-key-list (if (nth 5 tc) (append (nth 5 tc) ergoemacs-global-override-rm-keys) - ergoemacs-global-override-rm-keys)) - (setq ergoemacs-M-x (substitute-command-keys "\\[execute-extended-command] ")))) + ergoemacs-global-override-rm-keys)))) (defvar ergoemacs-theme-hash (make-hash-table :test 'equal))
