X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/38685583801c774f1c17a32f02b29e426bdd0a96..8830e9daaea2b953d5e3da06a3a17f8d27955339:/lisp/emulation/viper-cmd.el diff --git a/lisp/emulation/viper-cmd.el b/lisp/emulation/viper-cmd.el index 99a130e7f1..ac3ef55d6e 100644 --- a/lisp/emulation/viper-cmd.el +++ b/lisp/emulation/viper-cmd.el @@ -1,7 +1,7 @@ ;;; viper-cmd.el --- Vi command support for Viper ;; Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, -;; 2005 Free Software Foundation, Inc. +;; 2005, 2006 Free Software Foundation, Inc. ;; Author: Michael Kifer @@ -46,6 +46,8 @@ (defvar mark-even-if-inactive) (defvar init-message) (defvar initial) +(defvar undo-beg-posn) +(defvar undo-end-posn) ;; loading happens only in non-interactive compilation ;; in order to spare non-viperized emacs from being viperized @@ -196,6 +198,15 @@ (viper-save-cursor-color 'before-insert-mode)) ;; set insert mode cursor color (viper-change-cursor-color viper-insert-state-cursor-color))) + (if (and viper-emacs-state-cursor-color (eq viper-current-state 'emacs-state)) + (let ((has-saved-cursor-color-in-emacs-mode + (stringp (viper-get-saved-cursor-color-in-emacs-mode)))) + (or has-saved-cursor-color-in-emacs-mode + (string= (viper-get-cursor-color) viper-emacs-state-cursor-color) + ;; save current color, if not already saved + (viper-save-cursor-color 'before-emacs-mode)) + ;; set emacs mode cursor color + (viper-change-cursor-color viper-emacs-state-cursor-color))) (if (and (memq this-command '(dabbrev-expand hippie-expand)) (integerp viper-pre-command-point) @@ -358,7 +369,7 @@ 'viper-insertion-ring)) (if viper-ESC-moves-cursor-back - (or (bolp) (backward-char 1)))) + (or (bolp) (viper-beginning-of-field) (backward-char 1)))) )) ;; insert or replace @@ -397,7 +408,6 @@ ) - (defun viper-adjust-keys-for (state) "Make necessary adjustments to keymaps before entering STATE." (cond ((memq state '(insert-state replace-state)) @@ -494,13 +504,20 @@ viper-empty-keymap)) )) - ;; in emacs with emulation-mode-map-alists, nothing needs to be done + ;; This var is not local in Emacs, so we make it local. It must be local + ;; because although the stack of minor modes can be the same for all buffers, + ;; the associated *keymaps* can be different. In Viper, + ;; viper-vi-local-user-map, viper-insert-local-user-map, and others can have + ;; different keymaps for different buffers. Also, the keymaps associated + ;; with viper-vi/insert-state-modifier-minor-mode can be different. + ;; ***This is needed only in case emulation-mode-map-alists is not defined. + ;; In emacs with emulation-mode-map-alists, nothing needs to be done (unless (and (fboundp 'add-to-ordered-list) (boundp 'emulation-mode-map-alists)) - (setq minor-mode-map-alist - (viper-append-filter-alist - (append viper--intercept-key-maps viper--key-maps) - minor-mode-map-alist))) + (set (make-local-variable 'minor-mode-map-alist) + (viper-append-filter-alist + (append viper--intercept-key-maps viper--key-maps) + minor-mode-map-alist))) ) @@ -509,7 +526,7 @@ ;; Modifies mode-line-buffer-identification. (defun viper-refresh-mode-line () - (setq viper-mode-string + (set (make-local-variable 'viper-mode-string) (cond ((eq viper-current-state 'emacs-state) viper-emacs-state-id) ((eq viper-current-state 'vi-state) viper-vi-state-id) ((eq viper-current-state 'replace-state) viper-replace-state-id) @@ -636,9 +653,12 @@ (indent-to-left-margin)) (viper-add-newline-at-eob-if-necessary) (viper-adjust-undo) - (viper-change-state 'vi-state) - (viper-restore-cursor-color 'after-insert-mode) + (if (eq viper-current-state 'emacs-state) + (viper-restore-cursor-color 'after-emacs-mode) + (viper-restore-cursor-color 'after-insert-mode)) + + (viper-change-state 'vi-state) ;; Protect against user errors in hooks (condition-case conds @@ -702,9 +722,18 @@ (or (viper-overlay-p viper-replace-overlay) (viper-set-replace-overlay (point-min) (point-min))) (viper-hide-replace-overlay) + + (if viper-emacs-state-cursor-color + (let ((has-saved-cursor-color-in-emacs-mode + (stringp (viper-get-saved-cursor-color-in-emacs-mode)))) + (or has-saved-cursor-color-in-emacs-mode + (string= (viper-get-cursor-color) viper-emacs-state-cursor-color) + (viper-save-cursor-color 'before-emacs-mode)) + (viper-change-cursor-color viper-emacs-state-cursor-color))) + (viper-change-state 'emacs-state) - ;; Protect agains user errors in hooks + ;; Protect against user errors in hooks (condition-case conds (run-hooks 'viper-emacs-state-hook) (error @@ -813,12 +842,12 @@ Vi's prefix argument will be used. Otherwise, the prefix argument passed to ;; The next cmd and viper-set-unread-command-events ;; are intended to prevent the input method ;; from swallowing ^M, ^Q and other special characters - (setq ch (read-char)) + (setq ch (read-char-exclusive)) ;; replace ^M with the newline (if (eq ch ?\C-m) (setq ch ?\n)) ;; Make sure ^V and ^Q work as quotation chars (if (memq ch '(?\C-v ?\C-q)) - (setq ch (read-char))) + (setq ch (read-char-exclusive))) (viper-set-unread-command-events ch) (quail-input-method nil) @@ -835,12 +864,12 @@ Vi's prefix argument will be used. Otherwise, the prefix argument passed to ;; same as above but for XEmacs, which doesn't have ;; quail-input-method (let (unread-command-events) - (setq ch (read-char)) + (setq ch (read-char-exclusive)) ;; replace ^M with the newline (if (eq ch ?\C-m) (setq ch ?\n)) ;; Make sure ^V and ^Q work as quotation chars (if (memq ch '(?\C-v ?\C-q)) - (setq ch (read-char))) + (setq ch (read-char-exclusive))) (viper-set-unread-command-events ch) (quail-start-translation nil) @@ -860,12 +889,20 @@ Vi's prefix argument will be used. Otherwise, the prefix argument passed to (setq ch (aref (read-key-sequence nil) 0))) (insert ch)) (t - (setq ch (read-char)) + ;;(setq ch (read-char-exclusive)) + (setq ch (aref (read-key-sequence nil) 0)) + (if viper-xemacs-p + (setq ch (event-to-character ch))) ;; replace ^M with the newline (if (eq ch ?\C-m) (setq ch ?\n)) ;; Make sure ^V and ^Q work as quotation chars (if (memq ch '(?\C-v ?\C-q)) - (setq ch (read-char))) + (progn + ;;(setq ch (read-char-exclusive)) + (setq ch (aref (read-key-sequence nil) 0)) + (if viper-xemacs-p + (setq ch (event-to-character ch)))) + ) (insert ch)) ) (setq last-command-event @@ -1000,10 +1037,13 @@ as a Meta key and any number of multiple escapes is allowed." (inhibit-quit t)) (if (viper-ESC-event-p event) (progn - ;; Emacs 22.50.8 introduced a bug, which makes even a single ESC into - ;; a fast keyseq. To guard against this, we added a check if there - ;; are other events as well - (if (and (viper-fast-keysequence-p) unread-command-events) + ;; Some versions of Emacs (eg., 22.50.8 have a bug, which makes even + ;; a single ESC into ;; a fast keyseq. To guard against this, we + ;; added a check if there are other events as well. Keep the next + ;; line for the next time the bug reappears, so that will remember to + ;; report it. + ;;(if (and (viper-fast-keysequence-p) unread-command-events) + (if (viper-fast-keysequence-p) ;; for Emacsen without the above bug (progn (let (minor-mode-map-alist emulation-mode-map-alists) (viper-set-unread-command-events event) @@ -1222,65 +1262,69 @@ as a Meta key and any number of multiple escapes is allowed." (setq com char) (setq char (read-char)))))) - (if (atom com) - ;; `com' is a single char, so we construct the command argument - ;; and if `char' is `?', we describe the arg; otherwise - ;; we prepare the command that will be executed at the end. - (progn - (setq cmd-info (cons value com)) - (while (viper= char ?U) - (viper-describe-arg cmd-info) - (setq char (read-char))) - ;; `char' is a movement cmd, a digit arg cmd, or a register cmd---so we - ;; execute it at the very end - (or (viper-movement-command-p char) - (viper-digit-command-p char) - (viper-regsuffix-command-p char) - (viper= char ?!) ; bang command - (error "")) - (setq cmd-to-exec-at-end - (viper-exec-form-in-vi - `(key-binding (char-to-string ,char))))) - - ;; as com is non-nil, this means that we have a command to execute - (if (viper-memq-char (car com) '(?r ?R)) - ;; execute apropriate region command. - (let ((char (car com)) (com (cdr com))) - (setq prefix-arg (cons value com)) - (if (viper= char ?r) - (viper-region prefix-arg) - (viper-Region prefix-arg)) - ;; reset prefix-arg - (setq prefix-arg nil)) - ;; otherwise, reset prefix arg and call appropriate command - (setq value (if (null value) 1 value)) - (setq prefix-arg nil) - (cond - ;; If we change ?C to ?c here, then cc will enter replacement mode - ;; rather than deleting lines. However, it will affect 1 less line than - ;; normal. We decided to not use replacement mode here and follow Vi, - ;; since replacement mode on n full lines can be achieved with nC. - ((equal com '(?c . ?c)) (viper-line (cons value ?C))) - ((equal com '(?d . ?d)) (viper-line (cons value ?D))) - ((equal com '(?d . ?y)) (viper-yank-defun)) - ((equal com '(?y . ?y)) (viper-line (cons value ?Y))) - ((equal com '(?< . ?<)) (viper-line (cons value ?<))) - ((equal com '(?> . ?>)) (viper-line (cons value ?>))) - ((equal com '(?! . ?!)) (viper-line (cons value ?!))) - ((equal com '(?= . ?=)) (viper-line (cons value ?=))) - (t (error ""))))) - - (if cmd-to-exec-at-end - (progn - (setq last-command-char char) - (setq last-command-event - (viper-copy-event - (if viper-xemacs-p (character-to-event char) char))) - (condition-case nil - (funcall cmd-to-exec-at-end cmd-info) - (error - (error ""))))) - )) + (if (atom com) + ;; `com' is a single char, so we construct the command argument + ;; and if `char' is `?', we describe the arg; otherwise + ;; we prepare the command that will be executed at the end. + (progn + (setq cmd-info (cons value com)) + (while (viper= char ?U) + (viper-describe-arg cmd-info) + (setq char (read-char))) + ;; `char' is a movement cmd, a digit arg cmd, or a register cmd---so + ;; we execute it at the very end + (or (viper-movement-command-p char) + (viper-digit-command-p char) + (viper-regsuffix-command-p char) + (viper= char ?!) ; bang command + (viper= char ?g) ; the gg command (like G0) + (error "")) + (setq cmd-to-exec-at-end + (viper-exec-form-in-vi + `(key-binding (char-to-string ,char))))) + + ;; as com is non-nil, this means that we have a command to execute + (if (viper-memq-char (car com) '(?r ?R)) + ;; execute apropriate region command. + (let ((char (car com)) (com (cdr com))) + (setq prefix-arg (cons value com)) + (if (viper= char ?r) + (viper-region prefix-arg) + (viper-Region prefix-arg)) + ;; reset prefix-arg + (setq prefix-arg nil)) + ;; otherwise, reset prefix arg and call appropriate command + (setq value (if (null value) 1 value)) + (setq prefix-arg nil) + (cond + ;; If we change ?C to ?c here, then cc will enter replacement mode + ;; rather than deleting lines. However, it will affect 1 less line + ;; than normal. We decided to not use replacement mode here and + ;; follow Vi, since replacement mode on n full lines can be achieved + ;; with nC. + ((equal com '(?c . ?c)) (viper-line (cons value ?C))) + ((equal com '(?d . ?d)) (viper-line (cons value ?D))) + ((equal com '(?d . ?y)) (viper-yank-defun)) + ((equal com '(?y . ?y)) (viper-line (cons value ?Y))) + ((equal com '(?< . ?<)) (viper-line (cons value ?<))) + ((equal com '(?> . ?>)) (viper-line (cons value ?>))) + ((equal com '(?! . ?!)) (viper-line (cons value ?!))) + ((equal com '(?= . ?=)) (viper-line (cons value ?=))) + ;; gg acts as G0 + ((equal (car com) ?g) (viper-goto-line 0)) + (t (error ""))))) + + (if cmd-to-exec-at-end + (progn + (setq last-command-char char) + (setq last-command-event + (viper-copy-event + (if viper-xemacs-p (character-to-event char) char))) + (condition-case nil + (funcall cmd-to-exec-at-end cmd-info) + (error + (error ""))))) + )) (defun viper-describe-arg (arg) (let (val com) @@ -1692,6 +1736,7 @@ invokes the command before that, etc." (max viper-com-point (point)))) ((viper= char ?g) (push-mark viper-com-point t) + ;; execute the last emacs kbd macro on each line of the region (viper-global-execute)) ((viper= char ?q) (push-mark viper-com-point t) @@ -1703,42 +1748,63 @@ invokes the command before that, etc." ;; undoing +;; hook used inside undo +(defvar viper-undo-functions nil) + +;; Runs viper-before-change-functions inside before-change-functions +(defun viper-undo-sentinel (beg end length) + (run-hook-with-args 'viper-undo-functions beg end length)) + +(add-hook 'after-change-functions 'viper-undo-sentinel) + +;; Hook used in viper-undo +(defun viper-after-change-undo-hook (beg end len) + (if (and (boundp 'undo-in-progress) undo-in-progress) + (setq undo-beg-posn beg + undo-end-posn (or end beg)) + ;; some other hooks may be changing various text properties in + ;; the buffer in response to 'undo'; so remove this hook to avoid + ;; its repeated invocation + (remove-hook 'viper-undo-functions 'viper-after-change-undo-hook 'local) + )) + (defun viper-undo () "Undo previous change." (interactive) (message "undo!") (let ((modified (buffer-modified-p)) (before-undo-pt (point-marker)) - (after-change-functions after-change-functions) undo-beg-posn undo-end-posn) - ;; no need to remove this hook, since this var has scope inside a let. - (add-hook 'after-change-functions - '(lambda (beg end len) - (setq undo-beg-posn beg - undo-end-posn (or end beg)))) + ;; the viper-after-change-undo-hook removes itself after the 1st invocation + (add-hook 'viper-undo-functions 'viper-after-change-undo-hook nil 'local) (undo-start) (undo-more 2) - (setq undo-beg-posn (or undo-beg-posn before-undo-pt) - undo-end-posn (or undo-end-posn undo-beg-posn)) + ;;(setq undo-beg-posn (or undo-beg-posn (point)) + ;; undo-end-posn (or undo-end-posn (point))) + ;;(setq undo-beg-posn (or undo-beg-posn before-undo-pt) + ;; undo-end-posn (or undo-end-posn undo-beg-posn)) - (goto-char undo-beg-posn) - (sit-for 0) - (if (and viper-keep-point-on-undo - (pos-visible-in-window-p before-undo-pt)) + (if (and undo-beg-posn undo-end-posn) (progn - (push-mark (point-marker) t) - (viper-sit-for-short 300) - (goto-char undo-end-posn) - (viper-sit-for-short 300) - (if (and (> (viper-chars-in-region undo-beg-posn before-undo-pt) 1) - (> (viper-chars-in-region undo-end-posn before-undo-pt) 1)) - (goto-char before-undo-pt) - (goto-char undo-beg-posn))) - (push-mark before-undo-pt t)) + (goto-char undo-beg-posn) + (sit-for 0) + (if (and viper-keep-point-on-undo + (pos-visible-in-window-p before-undo-pt)) + (progn + (push-mark (point-marker) t) + (viper-sit-for-short 300) + (goto-char undo-end-posn) + (viper-sit-for-short 300) + (if (pos-visible-in-window-p undo-beg-posn) + (goto-char before-undo-pt) + (goto-char undo-beg-posn))) + (push-mark before-undo-pt t)) + )) + (if (and (eolp) (not (bolp))) (backward-char 1)) - (if (not modified) (set-buffer-modified-p t))) + ) (setq this-command 'viper-undo)) ;; Continue undoing previous changes. @@ -1786,7 +1852,7 @@ invokes the command before that, etc." (setq viper-undo-needs-adjustment t))))) - +;;; Viper's destructive Command ring utilities (defun viper-display-current-destructive-command () (let ((text (nth 4 viper-d-com)) @@ -1900,12 +1966,15 @@ Undo previous insertion and inserts new." (end-of-line) ;; make sure all lines end with newline, unless in the minibuffer or ;; when requested otherwise (require-final-newline is nil) - (if (and (eobp) - (not (bolp)) - require-final-newline - (not (viper-is-in-minibuffer)) - (not buffer-read-only)) - (insert "\n")))) + (save-restriction + (widen) + (if (and (eobp) + (not (bolp)) + require-final-newline + (not (viper-is-in-minibuffer)) + (not buffer-read-only)) + (insert "\n"))) + )) (defun viper-yank-defun () (mark-defun) @@ -1996,7 +2065,8 @@ Undo previous insertion and inserts new." ;;; Minibuffer business (defsubst viper-set-minibuffer-style () - (add-hook 'minibuffer-setup-hook 'viper-minibuffer-setup-sentinel)) + (add-hook 'minibuffer-setup-hook 'viper-minibuffer-setup-sentinel) + (add-hook 'post-command-hook 'viper-minibuffer-post-command-hook)) (defun viper-minibuffer-setup-sentinel () @@ -2039,6 +2109,11 @@ Undo previous insertion and inserts new." (minibuffer-prompt-end) (point-min))) +(defun viper-minibuffer-post-command-hook() + (when (active-minibuffer-window) + (when (< (point) (viper-minibuffer-real-start)) + (goto-char (viper-minibuffer-real-start))))) + ;; Interpret last event in the local map first; if fails, use exit-minibuffer. ;; Run viper-minibuffer-exit-hook before exiting. @@ -2118,7 +2193,7 @@ To turn this feature off, set this variable to nil." Remove this function from `viper-minibuffer-exit-hook', if this causes problems." (if (viper-is-in-minibuffer) - (progn + (let ((inhibit-field-text-motion t)) (goto-char (viper-minibuffer-real-start)) (end-of-line) (delete-region (point) (point-max))))) @@ -2154,7 +2229,7 @@ problems." (setq keymap (or keymap minibuffer-local-map) initial (or initial "") temp-msg (if default - (format "(default: %s) " default) + (format "(default %s) " default) "")) (setq viper-incomplete-ex-cmd nil) @@ -2570,7 +2645,7 @@ These keys are ESC, RET, and LineFeed" ;; last line of buffer when this line has no \n. (viper-add-newline-at-eob-if-necessary) (viper-execute-com 'viper-line val com)) - (if (and (eobp) (not (bobp))) (forward-line -1)) + (if (and (eobp) (bolp) (not (bobp))) (forward-line -1)) ) (defun viper-yank-line (arg) @@ -3012,19 +3087,34 @@ On reaching beginning of line, stop and signal error." (setq this-command 'next-line) (if com (viper-execute-com 'viper-next-line val com)))) + (defun viper-next-line-at-bol (arg) - "Next line at beginning of line." + "Next line at beginning of line. +If point is on a widget or a button, simulate clicking on that widget/button." (interactive "P") - (viper-leave-region-active) - (save-excursion - (end-of-line) - (if (eobp) (error "Last line in buffer"))) - (let ((val (viper-p-val arg)) - (com (viper-getCom arg))) - (if com (viper-move-marker-locally 'viper-com-point (point))) - (forward-line val) - (back-to-indentation) - (if com (viper-execute-com 'viper-next-line-at-bol val com)))) + (let* ((field (get-char-property (point) 'field)) + (button (get-char-property (point) 'button)) + (doc (get-char-property (point) 'widget-doc)) + (widget (or field button doc))) + (if (and widget + (if (symbolp widget) + (get widget 'widget-type) + (and (consp widget) + (get (widget-type widget) 'widget-type)))) + (widget-button-press (point)) + (if (and (fboundp 'button-at) (fboundp 'push-button) (button-at (point))) + (push-button) + ;; not a widget or a button + (viper-leave-region-active) + (save-excursion + (end-of-line) + (if (eobp) (error "Last line in buffer"))) + (let ((val (viper-p-val arg)) + (com (viper-getCom arg))) + (if com (viper-move-marker-locally 'viper-com-point (point))) + (forward-line val) + (back-to-indentation) + (if com (viper-execute-com 'viper-next-line-at-bol val com))))))) (defun viper-previous-line (arg) @@ -3883,7 +3973,8 @@ Null string will repeat previous search." (let ((val (viper-p-val arg)) (com (viper-getcom arg)) debug-on-error) - (if (null viper-s-string) (error viper-NoPrevSearch)) + (if (or (null viper-s-string) (string= viper-s-string "")) + (error viper-NoPrevSearch)) (viper-search viper-s-string viper-s-forward arg) (if com (progn @@ -3909,6 +4000,7 @@ Null string will repeat previous search." (defun viper-buffer-search-enable (&optional c) (cond (c (setq viper-buffer-search-char c)) ((null viper-buffer-search-char) + ;; ?g acts as a default value for viper-buffer-search-char (setq viper-buffer-search-char ?g))) (define-key viper-vi-basic-map (cond ((viper-characterp viper-buffer-search-char) @@ -4775,7 +4867,7 @@ sensitive for VI-style look-and-feel." level-changed t) (insert " Please specify your level of familiarity with the venomous VI PERil -(and the VI Plan for Emacs Rescue). +\(and the VI Plan for Emacs Rescue). You can change it at any time by typing `M-x viper-set-expert-level RET' 1 -- BEGINNER: Almost all Emacs features are suppressed. @@ -4994,5 +5086,5 @@ Mail anyway (y or n)? ") -;;; arch-tag: 739a6450-5fda-44d0-88b0-325053d888c2 +;; arch-tag: 739a6450-5fda-44d0-88b0-325053d888c2 ;;; viper-cmd.el ends here