diff --git a/vimpulse-dependencies.el b/vimpulse-dependencies.el index 9dae8d9..5f58e69 100644 --- a/vimpulse-dependencies.el +++ b/vimpulse-dependencies.el @@ -240,14 +240,14 @@ or a character position.") (defvar vimpulse-last-command-event nil "Value for overwriting `last-command-event'. -Used by `vimpulse-modal-pre-hook'.") +Used by `vimpulse-careful-pre-hook'.") -(defvar vimpulse-modal-alist nil - "Key bindings for which `vimpulse-modal-pre-hook' is active. +(defvar vimpulse-careful-alist nil + "Key bindings for which `vimpulse-careful-pre-hook' is active. That is, `last-command-event' and `read-char' work differently for these bindings. The format is (KEY-VECTOR . COMMAND).") -(defvar vimpulse-modal-map (make-sparse-keymap) +(defvar vimpulse-careful-map (make-sparse-keymap) "Keymap of bindings overwritten by `vimpulse-map' et al.") (defvar vimpulse-paren-overlay-open nil @@ -414,6 +414,17 @@ the region acted on.") (defvar vimpulse-search-prompt nil "String to use for vi-like searching.") +(defvar vimpulse-auxiliary-modes-alist + '((vi-state . viper-vi-auxiliary-modes) + (insert-state . viper-insert-auxiliary-modes) + (replace-state . viper-replace-auxiliary-modes) + (emacs-state . viper-emacs-auxiliary-modes))) + +(defvar viper-vi-auxiliary-modes nil) +(defvar viper-insert-auxiliary-modes nil) +(defvar viper-replace-auxiliary-modes nil) +(defvar viper-emacs-auxiliary-modes nil) + ;;; Carefully set Viper/woman variables (defun vimpulse-configure-variables () diff --git a/vimpulse-modal.el b/vimpulse-modal.el index 2a9388d..c044099 100644 --- a/vimpulse-modal.el +++ b/vimpulse-modal.el @@ -1,9 +1,9 @@ ;;;; Modal keybinding functions ;; This provides the functions `vimpulse-map', `vimpulse-imap', -;; `vimpulse-vmap' and `vimpulse-omap', which mimic :map, :imap, -;; :vmap and :omap in Vim, as well as `vimpulse-define-key', a -;; general-purpose function for binding keys in a "careful" way. +;; `vimpulse-vmap' and `vimpulse-omap', which mimic :map, :imap, :vmap +;; and :omap in Vim, as well as `vimpulse-careful-binding', which +;; makes bindings "on top of" previous bindings. ;; ;; BACKGROUND ;; @@ -32,7 +32,7 @@ ;; new key bindings "on top of" previous bindings. They are ;; `vimpulse-map', `vimpulse-imap', `vimpulse-vmap' and ;; `vimpulse-omap', which mimic Vim's commands, and -;; `vimpulse-define-key', a general function for specifying the +;; `vimpulse-careful-binding', a general function for specifying the ;; keymap. Returning to the example: ;; ;; (vimpulse-imap "aa" 'foo) @@ -43,13 +43,13 @@ ;; sequence may be specified as a string, like above, as a vector ;; (like [?a ?b ?c]), or as a call to `kbd' (like (kbd "a b c")). ;; -;; To make a binding in vi (command) mode, use `vimpulse-map'; -;; in Insert mode, `vimpulse-imap'; in Visual mode, `vimpulse-vmap'; -;; in Operator-Pending mode, `vimpulse-omap'. The more general -;; `vimpulse-define-key' function lets one specify the keymap to store -;; the binding in, as when using `define-key': +;; To make a binding in vi (command) mode, use `vimpulse-map'; in +;; Insert mode, `vimpulse-imap'; in Visual mode, `vimpulse-vmap'; in +;; Operator-Pending mode, `vimpulse-omap'. The more general +;; `vimpulse-careful-binding' function lets one specify the keymap to +;; store the binding in, as when using `define-key': ;; -;; (vimpulse-define-key keymap "abc" 'command) +;; (vimpulse-careful-binding keymap "abc" 'command) ;; ;; IMPLEMENTATION ;; @@ -66,10 +66,10 @@ ;; and so on. For more on default key bindings, see the GNU Emacs ;; Lisp Reference Manual, chapter 22.3: "Format of Keymaps". ;; -;; What is done by functions like `vimpulse-define-key' and +;; What is done by functions like `vimpulse-careful-binding' and ;; `vimpulse-map' (which depends on the former) is to generate these ;; default bindings automatically. If "AB" is already bound to `foo' -;; and we modally bind "ABC" to `bar', the old binding is first +;; and we carefully bind "ABC" to `bar', the old binding is first ;; replaced by a default binding, as if we issued the following: ;; ;; (global-set-key (kbd "A B") nil) ; delete old binding @@ -85,7 +85,7 @@ ;; Viper binds "d" to the general command `viper-command-argument', ;; which, depending on the next key-presses, deletes a line, two ;; words, or any motion entered by the user. What happens if we decide -;; to modally bind, say, "dq" to a custom command `foo' of our own? +;; to carefully bind, say, "dq" to a custom command `foo' of our own? ;; ;; (global-set-key (kbd "d") nil) ; delete old binding ;; (global-set-key (kbd "d ") 'viper-command-argument) @@ -101,22 +101,23 @@ ;; ;; So, we need to find a way to pass "d" and "w" along in the proper ;; manner; that is, to make the default binding appear the same as the -;; old binding it replaces. This is done by `vimpulse-modal-pre-hook', +;; old binding it replaces. This is done by `vimpulse-careful-pre-hook', ;; which unreads "w" (so it can be read again) and changes ;; `last-command-event' to "d". Of course, this behavior is only ;; needed for default key bindings, and only for default key bindings -;; made by the modal binding functions. To that end, every time -;; `vimpulse-define-key' makes a default binding, the binding is -;; listed in `vimpulse-modal-alist' for future reference. Checking -;; against the list, `vimpulse-modal-pre-hook' only does its thing if -;; the current binding comes back positive. +;; made by careful bindings. To that end, every time +;; `vimpulse-careful-binding' makes a default binding, the binding is +;; listed in `vimpulse-careful-alist' for future reference. Checking +;; against the list, `vimpulse-careful-pre-hook' only does its thing +;; if the current binding comes back positive. ;; ;; XEmacs is somewhat fuzzy about its command loop variables, not ;; allowing direct modification of `last-command-event'. However, ;; shadowing it with a `let' binding is possible, and a wrap-around ;; advice of the current command is employed to accomplish this. Also, ;; XEmacs does not have default key bindings in quite the same way as -;; GNU Emacs; `vimpulse-default-binding' takes care of the differences. +;; GNU Emacs; `vimpulse-default-binding' takes care of the +;; differences. ;; ;; LIMITATIONS ;; @@ -134,7 +135,7 @@ "Make wrap-around advice for shadowing `last-command-event'. XEmacs does not allow us to change its command loop variables directly, but shadowing them with a `let' binding works." - `(defadvice ,command (around vimpulse-modal activate) + `(defadvice ,command (around vimpulse-careful activate) "Shadow `last-command-event' with a `let' binding." (cond (vimpulse-last-command-event @@ -149,37 +150,38 @@ directly, but shadowing them with a `let' binding works." ;;; General functions -(defun vimpulse-modal-check (key-sequence) +(defun vimpulse-careful-check (key-sequence) "Return t if KEY-SEQUENCE defaults to `this-command', -but only for bindings listed in `vimpulse-modal-alist'." +but only for bindings listed in `vimpulse-careful-alist'." (let ((temp-sequence (vimpulse-strip-prefix key-sequence))) (setq temp-sequence (vimpulse-truncate temp-sequence -1)) (and this-command ; may be nil (not (key-binding key-sequence)) ; only default bindings - (eq (cdr (assoc temp-sequence vimpulse-modal-alist)) + (eq (cdr (assoc temp-sequence vimpulse-careful-alist)) this-command)))) -(defun vimpulse-modal-remove (key-vector &optional recursive) - "Delete entry with KEY-VECTOR from `vimpulse-modal-alist'. +(defun vimpulse-careful-remove (key-vector &optional recursive) + "Delete entry with KEY-VECTOR from `vimpulse-careful-alist'. If RECURSIVE is non-nil, also delete entries whose key-vectors start with KEY-VECTOR." (if recursive - (dolist (entry vimpulse-modal-alist) + (dolist (entry vimpulse-careful-alist) (when (equal (vimpulse-truncate (car entry) (length key-vector)) key-vector) - (setq vimpulse-modal-alist - (delq entry vimpulse-modal-alist)))) - (assq-delete-all key-vector vimpulse-modal-alist))) + (setq vimpulse-careful-alist + (delq entry vimpulse-careful-alist)))) + (setq vimpulse-careful-alist + (assq-delete-all key-vector vimpulse-careful-alist)))) (defun vimpulse-xemacs-def-binding - (keymap key def &optional modal-binding define-func) - "Make a default binding in XEmacs. If MODAL-BINDING is + (keymap key def &optional careful-binding define-func) + "Make a default binding in XEmacs. If CAREFUL-BINDING is non-nil, advice DEF by means of `vimpulse-advice-command'." (let ((temp-sequence (vconcat key)) (submap (lookup-key keymap key))) (unless define-func (setq define-func 'define-key)) - (and modal-binding (commandp def) + (and careful-binding (commandp def) (eval `(vimpulse-advice-command ,def))) (and (> (length temp-sequence) 1) (eq (aref temp-sequence (1- (length temp-sequence))) t) @@ -193,31 +195,31 @@ non-nil, advice DEF by means of `vimpulse-advice-command'." (funcall define-func keymap temp-sequence submap))) (defun vimpulse-default-binding - (keymap key def &optional modal-binding define-func) + (keymap key def &optional careful-binding define-func) "Make a default binding in GNU Emacs or XEmacs, -whichever is appropriate. If MODAL-BINDING is non-nil, -the binding is listed in `vimpulse-modal-alist'." +whichever is appropriate. If CAREFUL-BINDING is non-nil, +the binding is listed in `vimpulse-careful-alist'." (let ((temp-sequence (vconcat key))) (unless define-func (setq define-func 'define-key)) (cond ((featurep 'xemacs) (vimpulse-xemacs-def-binding - keymap temp-sequence def modal-binding define-func)) + keymap temp-sequence def careful-binding define-func)) (t (unless (eq (aref temp-sequence (1- (length temp-sequence))) t) (setq temp-sequence (vconcat temp-sequence [t]))) (funcall define-func keymap temp-sequence def))) - (when modal-binding - (add-to-list 'vimpulse-modal-alist + (when careful-binding + (add-to-list 'vimpulse-careful-alist (cons (vimpulse-truncate temp-sequence -1) def))))) ;;; Hook run before each command -;; If the current command is a default key binding made by the modal -;; binding functions, we need to unread the last input events and -;; change some command loop variables to give the command the +;; If the current command is a default key binding made by +;; `vimpulse-careful-binding', we need to unread the last input events +;; and change some command loop variables to give the command the ;; impression of its "old" binding. -(defun vimpulse-modal-pre-hook () +(defun vimpulse-careful-pre-hook () "Update `vimpulse-last-command-event' and `unread-command-events'. If the current key-sequence defaults to a shorter key-sequence, the difference is stored in these two variables, to be passed on @@ -229,7 +231,7 @@ functions, respectively." (when (featurep 'xemacs) (setq key-sequence (events-to-keys key-sequence))) (while (and (> (length key-sequence) 1) - (vimpulse-modal-check key-sequence)) + (vimpulse-careful-check key-sequence)) ;; Unread last event. (setq vimpulse-last-command-event (elt key-sequence (1- (length key-sequence)))) @@ -252,19 +254,19 @@ functions, respectively." ;;; Hook run after each command ;; This merely ensures `vimpulse-last-command-event' is reset. -(defun vimpulse-modal-post-hook () +(defun vimpulse-careful-post-hook () "Erase `vimpulse-last-command-event'." (setq vimpulse-last-command-event nil)) -(add-hook 'pre-command-hook 'vimpulse-modal-pre-hook) -(add-hook 'post-command-hook 'vimpulse-modal-post-hook) +(add-hook 'pre-command-hook 'vimpulse-careful-pre-hook) +(add-hook 'post-command-hook 'vimpulse-careful-post-hook) ;;; Modal binding functions -;; `vimpulse-define-key' is general; `vimpulse-map', `vimpulse-imap' -;; and `vimpulse-vmap' imitate Vim's :map, :imap and :vmap, -;; respectively. -(defun vimpulse-define-key +;; `vimpulse-careful-binding' is general; `vimpulse-map', +;; `vimpulse-imap', `vimpulse-vmap' and `vimpulse-omap' imitate +;; Vim's :map, :imap, :vmap and :omap, respectively. +(defun vimpulse-careful-binding (keymap key def &optional dont-list define-func) "Carefully bind KEY to DEF in KEYMAP. \"Carefully\" means that if a subset of the key sequence is already @@ -277,7 +279,7 @@ overwrite the old. E.g., if we want to carefully bind \"A B C\" to which means that \"A B D\", for example, defaults to `bar'. (For more on default bindings, see `define-key'.) The default binding -gets listed in `vimpulse-modal-alist', so that, with regard to +gets listed in `vimpulse-careful-alist', so that, with regard to command loop variables, it appears exactly the same as the binding it replaced. To override this, use DONT-LIST. DEFINE-FUNC specifies a function to be used in place of @@ -309,14 +311,14 @@ only if called in the same state. The functions `vimpulse-map', (funcall define-func keymap key-vector def) (while (and (> (length key-vector) 1) (not (lookup-key keymap key-vector))) - (vimpulse-modal-remove key-vector t) + (vimpulse-careful-remove key-vector t) (setq key-vector (vimpulse-truncate key-vector -1)))) ;; `undefined' also unbinds, but less forcefully. ((eq def 'undefined) (if (keymapp (lookup-key keymap key-vector)) (vimpulse-default-binding keymap key-vector nil t define-func) (funcall define-func keymap key-vector def)) - (vimpulse-modal-remove key-vector)) + (vimpulse-careful-remove key-vector)) ;; Regular binding: convert previous bindings to default bindings. (t (dotimes (i (1- (length key-vector))) @@ -326,10 +328,10 @@ only if called in the same state. The functions `vimpulse-map', (setq current-binding (or (key-binding temp-sequence t) previous-binding))) (setq previous-binding current-binding) - ;; If `current-binding' is a keymap, do nothing, since our modal - ;; binding can exist happily as part of that keymap. However, if - ;; `current-binding' is a command, we need to make room for the - ;; modal binding by creating a default binding. + ;; If `current-binding' is a keymap, do nothing, since our + ;; careful binding can exist happily as part of that keymap. + ;; However, if `current-binding' is a command, we need to make + ;; room for the careful binding by creating a default binding. (unless (keymapp current-binding) (setq temp-sequence (vconcat temp-sequence [t])) (setq current-binding (lookup-key keymap temp-sequence t)) @@ -350,47 +352,100 @@ only if called in the same state. The functions `vimpulse-map', keymap key-vector def (not dont-list) define-func) (funcall define-func keymap key def)))))) -(define-minor-mode vimpulse-modal-minor-mode +(define-minor-mode vimpulse-careful-minor-mode "Minor mode of bindings overwritten by `vimpulse-map' et al." - :keymap vimpulse-modal-map - (dolist (entry vimpulse-modal-alist) - (unless (lookup-key vimpulse-modal-map (car entry)) - (define-key vimpulse-modal-map (car entry) (cdr entry)))) - (when vimpulse-modal-minor-mode + :keymap vimpulse-careful-map + (dolist (entry vimpulse-careful-alist) + (unless (lookup-key vimpulse-careful-map (car entry)) + (define-key vimpulse-careful-map (car entry) (cdr entry)))) + (when vimpulse-careful-minor-mode (viper-normalize-minor-mode-map-alist))) (add-to-list 'vimpulse-state-maps-alist - (cons 'vimpulse-modal-minor-mode 'vimpulse-modal-map)) + (cons 'vimpulse-careful-minor-mode 'vimpulse-careful-map)) + +(defun vimpulse-modal-binding (mode state key def &optional careful) + "Modally bind KEY to DEF in STATE for MODE. +STATE is one of `vi-state', `insert-state', `visual-state' or `operator-state'. +If CAREFUL is non-nil, make a careful binding with +`vimpulse-careful-binding'." + (let* ((entry (cdr (assq state vimpulse-auxiliary-modes-alist))) + (aux (cdr (assq mode (symbol-value entry)))) + (map (eval (cdr (assq aux vimpulse-state-maps-alist))))) + ;; If no auxiliary mode exists, create one. + (unless (keymapp map) + (setq aux (intern (format "vimpulse-%s-%s" state mode)) + map (intern (format "vimpulse-%s-%s-map" state mode))) + (eval `(viper-deflocalvar ,aux nil + ,(format "Auxiliary %s mode for `%s'." state mode))) + (eval `(viper-deflocalvar ,map (make-sparse-keymap) + ,(format "Auxiliary %s keymap for `%s'." state mode))) + (add-to-list 'vimpulse-state-maps-alist (cons aux map) t) + (add-to-list entry (cons mode aux) t) + (setq map (eval map))) + ;; Define key. + (if careful + (vimpulse-careful-binding map key def) + (define-key map key def)))) + +(defun vimpulse-major-modal-binding (mode state key def &optional careful) + "Modally bind KEY to DEF in STATE for major mode MODE. +STATE is one of `vi-state', `insert-state', `visual-state' or `operator-state'. +If CAREFUL is non-nil, make a careful binding with +`vimpulse-careful-binding'." + (let ((modifier-map (vimpulse-modifier-map state mode))) + (if careful + (vimpulse-with-state state + (vimpulse-careful-binding modifier-map key def)) + (define-key modifier-map key def)) + (viper-modify-major-mode mode state modifier-map))) + +(defalias 'vimpulse-minor-modal-binding 'vimpulse-modal-binding) + +(defun vimpulse-modal-set-key (state key def &optional local) + "Modally bind KEY to DEF in STATE. +STATE is one of `vi-state', `insert-state', `visual-state' or `operator-state'. +If LOCAL is non-nil, make a buffer-local binding; otherwise, +the binding is seen in all buffers." + (let* ((map (cdr (assq state vimpulse-state-vars-alist))) + (global-user-map (eval (cdr (assq 'global-user-map map))))) + (if local + (viper-add-local-keys state `((,key . ,def))) + (define-key global-user-map key def)))) + +(defun vimpulse-modal-set-key-carefully (state key def &optional local) + "Modally bind KEY to DEF in STATE, carefully. +STATE is one of `vi-state', `insert-state', `visual-state' or `operator-state'. +If LOCAL is non-nil, make a buffer-local binding; otherwise, +the binding is seen in all buffers." + (let* ((map (cdr (assq state vimpulse-state-vars-alist))) + (global-user-map (eval (cdr (assq 'global-user-map map))))) + (if local + (viper-add-local-keys state `((,key . ,def))) + (vimpulse-with-state state + (vimpulse-careful-binding global-user-map key def))))) + +(defalias 'modal-set-key 'vimpulse-modal-set-key) +(defalias 'modal-set-key-carefully 'vimpulse-modal-set-key-carefully) (defun vimpulse-map-state (state key def &optional modes) "Modally bind KEY to DEF in STATE. Don't use this function directly; see `vimpulse-map', `vimpulse-imap', `vimpulse-vmap' and `vimpulse-omap' instead." - (let* ((old-state viper-current-state) - (map (cdr (assq state vimpulse-state-vars-alist))) - (basic-map (eval (cdr (assq 'basic-map map)))) - (global-user-map (eval (cdr (assq 'global-user-map map))))) - (viper-set-mode-vars-for state) - (let ((viper-current-state state)) - (viper-normalize-minor-mode-map-alist)) - (cond - (modes - (dolist (mode modes) - (if (eq mode t) - (vimpulse-define-key global-user-map key def) - (setq map (vimpulse-modifier-map state mode)) - (vimpulse-define-key map key def) - (viper-modify-major-mode mode state map)))) - (t - (vimpulse-define-key basic-map key def))) - (viper-set-mode-vars-for old-state) - (viper-normalize-minor-mode-map-alist))) + (let* ((map (cdr (assq state vimpulse-state-vars-alist))) + (basic-map (eval (cdr (assq 'basic-map map))))) + (if modes + (dolist (mode modes) + (if (eq mode t) + (vimpulse-modal-set-key 'vi-state key def) + (vimpulse-major-modal-binding mode 'vi-state key def t))) + (vimpulse-careful-binding basic-map key def)))) (defun vimpulse-map-state-local (state key def) "Make a buffer-local binding for KEY and DEF in STATE. Don't use this function directly; see `vimpulse-map-local', `vimpulse-imap-local' and `vimpulse-vmap-local' instead." - (viper-add-local-keys state `((,key . ,def)))) + (vimpulse-modal-set-key-carefully state key def t)) (defun vimpulse-map (key def &rest modes) "Modally bind KEY to DEF in vi (command) state. diff --git a/vimpulse-utils.el b/vimpulse-utils.el index 64407a0..25c781e 100644 --- a/vimpulse-utils.el +++ b/vimpulse-utils.el @@ -150,6 +150,27 @@ in vi state and bind them to TO in KEYMAP." (vimpulse-get-vi-bindings from))) (define-key viper-vi-basic-map `[remap ,from] to))) +;;; States + +(defmacro vimpulse-with-state (state &rest body) + "Execute BODY with Viper state STATE, then restore previous state." + (declare (indent defun)) + `(let ((new-viper-state ,state) + (old-viper-state viper-current-state)) + (unwind-protect + (progn + (viper-set-mode-vars-for new-viper-state) + (let ((viper-current-state new-viper-state)) + (viper-normalize-minor-mode-map-alist) + ,@body)) + (viper-set-mode-vars-for old-viper-state) + (viper-normalize-minor-mode-map-alist)))) + +(when (fboundp 'font-lock-add-keywords) + (font-lock-add-keywords + 'emacs-lisp-mode + '(("(\\(vimpulse-with-state\\)\\>" 1 font-lock-keyword-face)))) + ;;; Vector tools (defun vimpulse-truncate (vector length &optional offset) @@ -174,7 +195,7 @@ If OFFSET is specified, skip first elements of VECTOR." (defun vimpulse-strip-prefix (key-sequence) "Strip any prefix argument keypresses from KEY-SEQUENCE. This is useful for deriving a \"standard\" key-sequence from -`this-command-keys', to be looked up in `vimpulse-modal-alist'." +`this-command-keys', to be looked up in `vimpulse-careful-alist'." (let* ((offset 0) (temp-sequence (vconcat key-sequence)) (key (aref temp-sequence offset)) diff --git a/vimpulse-viper-function-redefinitions.el b/vimpulse-viper-function-redefinitions.el index 1abd112..48b664c 100644 --- a/vimpulse-viper-function-redefinitions.el +++ b/vimpulse-viper-function-redefinitions.el @@ -174,6 +174,7 @@ Mark is buffer-local unless GLOBAL." (defvar vimpulse-state-vars-alist '((vi-state (id . viper-vi-state-id) + (auxiliary-modes . viper-vi-auxiliary-modes) (change-func . viper-change-state-to-vi) (basic-mode . viper-vi-basic-minor-mode) (basic-map . viper-vi-basic-map) @@ -192,6 +193,7 @@ Mark is buffer-local unless GLOBAL." (intercept-map . viper-vi-intercept-map)) (insert-state (id . viper-insert-state-id) + (auxiliary-modes . viper-insert-auxiliary-modes) (change-func . viper-change-state-to-insert) (basic-mode . viper-insert-basic-minor-mode) (basic-map . viper-insert-basic-map) @@ -209,12 +211,14 @@ Mark is buffer-local unless GLOBAL." (intercept-mode . viper-insert-intercept-minor-mode) (intercept-map . viper-insert-intercept-map)) (replace-state + (auxiliary-modes . viper-replace-auxiliary-modes) (id . viper-replace-state-id) (change-func . viper-change-state-to-replace) (basic-mode . viper-replace-minor-mode) (basic-map . viper-replace-map)) (emacs-state (id . viper-emacs-state-id) + (auxiliary-modes . viper-emacs-auxiliary-modes) (change-func . viper-change-state-to-emacs) (modifier-mode . viper-emacs-state-modifier-minor-mode) (modifier-alist . viper-emacs-state-modifier-alist) @@ -236,6 +240,7 @@ For example, the basic state keymap has the VAR-TYPE `basic-map'.") (viper-vi-intercept-minor-mode . t) (viper-vi-minibuffer-minor-mode . (viper-is-in-minibuffer)) (viper-vi-local-user-minor-mode . t) + (viper-vi-auxiliary-modes . t) (viper-vi-global-user-minor-mode . t) (viper-vi-kbd-minor-mode . (not (viper-is-in-minibuffer))) (viper-vi-state-modifier-minor-mode . t) @@ -248,6 +253,7 @@ For example, the basic state keymap has the VAR-TYPE `basic-map'.") (viper-replace-minor-mode . (eq state 'replace-state)) (viper-insert-minibuffer-minor-mode . (viper-is-in-minibuffer)) (viper-insert-local-user-minor-mode . t) + (viper-insert-auxiliary-modes . t) (viper-insert-global-user-minor-mode . t) (viper-insert-kbd-minor-mode . (not (viper-is-in-minibuffer))) (viper-insert-state-modifier-minor-mode . t) @@ -258,8 +264,10 @@ For example, the basic state keymap has the VAR-TYPE `basic-map'.") (replace-state (viper-insert-intercept-minor-mode . t) (viper-replace-minor-mode . (eq state 'replace-state)) + (viper-replace-auxiliary-modes . t) (viper-insert-minibuffer-minor-mode . (viper-is-in-minibuffer)) (viper-insert-local-user-minor-mode . t) + (viper-insert-auxiliary-modes . t) (viper-insert-global-user-minor-mode . t) (viper-insert-kbd-minor-mode . (not (viper-is-in-minibuffer))) (viper-insert-state-modifier-minor-mode . t) @@ -270,6 +278,7 @@ For example, the basic state keymap has the VAR-TYPE `basic-map'.") (emacs-state (viper-emacs-intercept-minor-mode . t) (viper-emacs-local-user-minor-mode . t) + (viper-emacs-auxiliary-modes . t) (viper-emacs-global-user-minor-mode . t) (viper-emacs-kbd-minor-mode . (not (viper-is-in-minibuffer))) (viper-emacs-state-modifier-minor-mode . t))) @@ -279,41 +288,134 @@ is the name of a state, MODE is a mode associated with STATE and EXPR is an expression with which to enable or disable MODE. The first modes get the highest priority.") -(defvar vimpulse-state-maps-alist nil +(defvar vimpulse-state-maps-alist + '((viper-vi-intercept-minor-mode . viper-vi-intercept-map) + (viper-vi-minibuffer-minor-mode . viper-minibuffer-map) + (viper-vi-local-user-minor-mode . viper-vi-local-user-map) + (viper-vi-global-user-minor-mode . viper-vi-global-user-map) + (viper-vi-kbd-minor-mode . viper-vi-kbd-map) + (viper-vi-state-modifier-minor-mode + . (if (keymapp (cdr (assoc major-mode viper-vi-state-modifier-alist))) + (cdr (assoc major-mode viper-vi-state-modifier-alist)))) + (viper-vi-diehard-minor-mode . viper-vi-diehard-map) + (viper-vi-basic-minor-mode . viper-vi-basic-map) + (viper-insert-intercept-minor-mode . viper-insert-intercept-map) + (viper-insert-minibuffer-minor-mode . viper-minibuffer-map) + (viper-insert-local-user-minor-mode . viper-insert-local-user-map) + (viper-insert-global-user-minor-mode . viper-insert-global-user-map) + (viper-insert-kbd-minor-mode . viper-insert-kbd-map) + (viper-insert-state-modifier-minor-mode + . (if (keymapp (cdr (assoc major-mode viper-insert-state-modifier-alist))) + (cdr (assoc major-mode viper-insert-state-modifier-alist)))) + (viper-insert-diehard-minor-mode . viper-insert-diehard-map) + (viper-insert-basic-minor-mode . viper-insert-basic-map) + (viper-replace-minor-mode . viper-replace-map) + (viper-emacs-intercept-minor-mode . viper-emacs-intercept-map) + (viper-emacs-local-user-minor-mode . viper-emacs-local-user-map) + (viper-emacs-global-user-minor-mode . viper-emacs-global-user-map) + (viper-emacs-kbd-minor-mode . viper-emacs-kbd-map) + (viper-emacs-state-modifier-minor-mode + . (if (keymapp (cdr (assoc major-mode viper-emacs-state-modifier-alist))) + (cdr (assoc major-mode viper-emacs-state-modifier-alist))))) "Alist of Vimpulse modes and keymaps. Entries have the form (MODE . MAP-EXPR), where MAP-EXPR is an expression for determining the keymap of MODE.") ;; State-changing code: this uses the variables above. -(defadvice viper-normalize-minor-mode-map-alist - (after vimpulse-states activate) - "Normalize Vimpulse state maps." - (let (temp mode map alists toggle toggle-alist) - ;; Determine which of `viper--key-maps' and - ;; `minor-mode-map-alist' to normalize. - (cond - ((featurep 'xemacs) - (setq alists '(viper--key-maps minor-mode-map-alist))) - ((>= emacs-major-version 22) - (setq alists '(viper--key-maps))) - (t - (setq alists '(minor-mode-map-alist)))) - ;; Normalize the modes in the order - ;; they are toggled by the current state. - (dolist (entry (reverse (cdr (assq viper-current-state - vimpulse-state-modes-alist)))) - (setq mode (car entry) - map (eval (cdr (assq mode vimpulse-state-maps-alist)))) - (when map - (dolist (alist alists) - (setq temp (default-value alist)) - (setq temp (assq-delete-all mode temp)) ; already there? - (add-to-list 'temp (cons mode map)) - (set-default alist temp) - (setq temp (eval alist)) - (setq temp (assq-delete-all mode temp)) - (add-to-list 'temp (cons mode map)) - (set alist temp)))))) +(defun vimpulse-normalize-minor-mode-map-alist () + "Normalize state keymaps." + (let (local-user-mode map mode modes) + ;; Refresh `viper--intercept-key-maps'. + (setq viper--intercept-key-maps nil) + (dolist (mode vimpulse-state-vars-alist) + (add-to-list 'viper--intercept-key-maps + (cons (cdr (assq 'intercept-mode mode)) + (eval (cdr (assq 'intercept-map mode)))) t)) + ;; Refresh `viper--key-maps'. + (setq viper--key-maps (vimpulse-make-keymap-alist viper-current-state)) + ;; Make `minor-mode-map-alist' buffer-local in older Emacs versions + ;; lacking `emulation-mode-map-alists'. + (unless (and (fboundp 'add-to-ordered-list) + (boundp 'emulation-mode-map-alists)) + (set (make-local-variable 'minor-mode-map-alist) + (viper-append-filter-alist + (append viper--intercept-key-maps viper--key-maps) + minor-mode-map-alist))))) + +(defun vimpulse-make-toggle-alist (state &rest excluded-states) + "Make toggle alist for STATE." + (let (mode result toggle) + (unless (memq state excluded-states) + (dolist (entry (cdr (assq state vimpulse-state-modes-alist))) + (setq toggle (cdr entry) + entry (car entry)) + (mapcar + (lambda (var) + (unless (assq (car var) result) + (if toggle + (add-to-list 'result var t) + (add-to-list 'result (cons (car var) nil))))) + (cond + ;; State reference. + ((assq entry vimpulse-state-modes-alist) + (apply 'vimpulse-make-toggle-alist entry state excluded-states)) + ;; Auxiliary modes. + ((rassq entry vimpulse-auxiliary-modes-alist) + (let (aux result) + (setq entry (symbol-value entry)) + (dolist (mode minor-mode-map-alist) + (setq mode (car mode)) + (when (assq mode entry) + (setq aux (cdr (assq mode entry))) + (unless (assq aux result) + (add-to-list 'result (cons aux toggle) t)))) + (when (assq major-mode entry) + (setq aux (cdr (assq major-mode entry))) + (unless (assq aux result) + (add-to-list 'result (cons aux toggle) t))) + result)) + ;; Regular mode. + (t + (unless (assq entry result) + (list (cons entry toggle)))))))) + result)) + +(defun vimpulse-make-keymap-alist (state) + "Make keymap alist for STATE." + (let (result map) + (setq result (mapcar (lambda (entry) + (cons (car entry) + (eval (cdr (assq (car entry) + vimpulse-state-maps-alist))))) + (vimpulse-make-toggle-alist state))) + (dolist (entry vimpulse-state-modes-alist) + (dolist (mode (cdr entry)) + (setq mode (car mode)) + (unless (or (assq mode result) + (assq mode vimpulse-state-modes-alist) + (rassq mode vimpulse-auxiliary-modes-alist))) + (add-to-list 'result + (cons mode + (eval (cdr (assq mode vimpulse-state-maps-alist)))) + t))) + result)) + +(defun vimpulse-normalize-auxiliary-modes () + "Normalize auxiliary modes for minor modes." + (let ((aux-modes (assq viper-current-state vimpulse-auxiliary-modes-alist)) + aux map) + (dolist (mode minor-mode-map-alist) + (setq mode (car mode)) + (when (assq mode aux-modes) + (setq aux (cdr (assq mode aux-modes)) + map (eval (cdr (assq aux vimpulse-state-maps-alist)))) + (add-to-list 'viper--key-maps (cons aux map) t))) + (when (assq major-mode aux-modes) + (setq aux (cdr (assq major-mode aux-modes)) + map (eval (cdr (assq aux vimpulse-state-maps-alist)))) + (add-to-list 'viper--key-maps (cons aux map) t)))) + +(defalias 'viper-normalize-minor-mode-map-alist 'vimpulse-normalize-minor-mode-map-alist) (defadvice viper-refresh-mode-line (after vimpulse-states activate) "Refresh mode line tag for Vimpulse states." @@ -327,21 +429,26 @@ expression for determining the keymap of MODE.") "Toggle Vimpulse state modes." (let (enable disable) ;; Determine which modes to enable. - (setq enable (cdr (assq state vimpulse-state-modes-alist))) - (when enable - ;; Determine which modes to disable. - (dolist (entry vimpulse-state-modes-alist) - (dolist (mode (mapcar 'car (cdr entry))) - (unless (assq mode enable) - (add-to-list 'disable mode t)))) - ;; Enable modes. - (dolist (entry enable) - (when (boundp (car entry)) - (set (car entry) (eval (cdr entry))))) - ;; Disable modes. - (dolist (entry disable) - (when (boundp entry) - (set entry nil)))))) + (setq enable (vimpulse-make-toggle-alist state)) + ;; Determine which modes to disable. + (dolist (entry vimpulse-state-modes-alist) + (dolist (mode (mapcar 'car (cdr entry))) + (unless (or (assq mode enable) + (assq mode vimpulse-state-modes-alist) + (rassq mode vimpulse-auxiliary-modes-alist)) + (add-to-list 'disable mode t)))) + (dolist (entry vimpulse-auxiliary-modes-alist) + (dolist (aux (mapcar 'cdr (symbol-value (cdr entry)))) + (unless (assq aux enable) + (add-to-list 'disable aux t)))) + ;; Enable modes. + (dolist (entry enable) + (when (boundp (car entry)) + (set (car entry) (eval (cdr entry))))) + ;; Disable modes. + (dolist (entry disable) + (when (boundp entry) + (set entry nil))))) (defadvice viper-change-state (before vimpulse-states activate) "Update `viper-insert-point'." @@ -469,12 +576,12 @@ of `viper-change-state'. :advice specifies the advice type [&rest [keywordp sexp]] def-body)) (indent defun)) - (let (advice basic-map basic-mode change-func diehard-map - diehard-mode enable global-user-map global-user-mode hook id - intercept-map intercept-mode kbd-map kbd-mode keyword - local-user-map local-user-mode modifier-alist modifier-mode - name name-string need-local-map prefix prefixed-name-string - state-name state-name-string) + (let (advice auxiliary-modes basic-map basic-mode change-func + diehard-map diehard-mode enable global-user-map + global-user-mode hook id intercept-map intercept-mode kbd-map + kbd-mode keyword local-user-map local-user-mode modifier-alist + modifier-mode name name-string need-local-map prefix + prefixed-name-string state-name state-name-string) ;; Collect keywords. (while (keywordp (setq keyword (car body))) (setq body (cdr body)) @@ -545,6 +652,8 @@ of `viper-change-state'. :advice specifies the advice type "-$" "" prefix) "-")) (setq prefixed-name-string (concat prefix name-string)) (setq advice (or advice 'after)) + (setq auxiliary-modes (intern (concat prefixed-name-string + "-auxiliary-modes"))) (unless (and change-func (symbolp change-func)) (setq change-func (intern (concat prefix "change-state-to-" name-string)))) @@ -556,6 +665,7 @@ of `viper-change-state'. :advice specifies the advice type (viper-change-state ',state-name)) ;; Define state variables etc. (let* ((advice ',advice) + (auxiliary-modes ',auxiliary-modes) (change-func ',change-func) (doc ',doc) (enable ',enable) @@ -682,6 +792,9 @@ mode-specific modifications to %s.\n\n%s" state-name doc) t)) enable-modes-alist enable-states-alist modes-alist vars-alist) (put need-local-map 'permanent-local t) + (defvar ,auxiliary-modes nil) + (add-to-list 'vimpulse-auxiliary-modes-alist + (cons ',state-name ',auxiliary-modes) t) ;; Remove old index entries. (dolist (entry (list basic-mode diehard-mode @@ -724,7 +837,7 @@ mode-specific modifications to %s.\n\n%s" state-name doc) t)) (let ((mode entry) (val t)) (when (listp entry) (setq mode (car entry) - val (cadr entry))) + val (cadr entry))) (when (and mode (symbolp mode)) (add-to-list 'enable-modes-alist (cons mode val) t)))) ;; Then add the state's own modes to the front @@ -736,20 +849,20 @@ mode-specific modifications to %s.\n\n%s" state-name doc) t)) (cons modifier-mode t) (cons kbd-mode '(not (viper-is-in-minibuffer))) (cons global-user-mode t) + (cons auxiliary-modes t) (cons local-user-mode t) (cons intercept-mode t))) (unless (assq (car mode) enable-modes-alist) (add-to-list 'enable-modes-alist mode))) - ;; Add the result to `vimpulse-state-modes-alist' - ;; and update any state references therein. + ;; Add the result to `vimpulse-state-modes-alist'. (add-to-list 'vimpulse-state-modes-alist (cons state-name enable-modes-alist) t) - (vimpulse-refresh-state-modes-alist) (viper-normalize-minor-mode-map-alist) ;; Index state variables. (setq vars-alist (list (cons 'id id) (cons 'hook hook) + (cons 'auxiliary-modes auxiliary-modes) (cons 'change-func change-func) (cons 'basic-mode basic-mode) (cons 'basic-map basic-map) @@ -806,38 +919,6 @@ create a buffer-local variable. Returns the result." (make-variable-buffer-local varname))) varname) -(defun vimpulse-refresh-state-modes-alist (&optional state &rest states) - "Expand state references in `vimpulse-state-modes-alist'." - (cond - (state - (let* ((state-entry (assq state vimpulse-state-modes-alist)) - (state-list (cdr state-entry)) - mode toggle) - (setq state-entry nil) - (dolist (modes (reverse state-list) state-entry) - (setq mode (car modes)) - (setq toggle (cdr modes)) - (if (and (assq mode vimpulse-state-modes-alist) - (not (eq mode state)) - (not (memq mode states))) - (setq modes (vimpulse-refresh-state-modes-alist - mode (append (list state) states))) - (setq modes (list modes))) - (dolist (entry (reverse modes) state-entry) - (setq state-entry (assq-delete-all (car entry) state-entry)) - (if toggle - (add-to-list 'state-entry entry) - (add-to-list 'state-entry (cons (car entry) nil))))))) - (t - (dolist (state-entry vimpulse-state-modes-alist) - (setq state (car state-entry)) - (setq state-entry - (vimpulse-refresh-state-modes-alist state)) - (setq vimpulse-state-modes-alist - (assq-delete-all state vimpulse-state-modes-alist)) - (add-to-list 'vimpulse-state-modes-alist - (cons state state-entry) t))))) - ;;; Viper bugs (should be forwarded to Michael Kifer) ;; `viper-deflocalvar's definition lacks a `declare' statement,