;;; 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 <kifer@cs.stonybrook.edu>
(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
(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)
'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
)
-
(defun viper-adjust-keys-for (state)
"Make necessary adjustments to keymaps before entering STATE."
(cond ((memq state '(insert-state replace-state))
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)))
)
;; 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)
(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
(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
;; 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)
;; 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)
(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
(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)
(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)
(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)
\f
;; 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.
(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))
(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)
;;; 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 ()
(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.
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)))))
(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)
;; 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)
(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)
(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
(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)
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.
-;;; arch-tag: 739a6450-5fda-44d0-88b0-325053d888c2
+;; arch-tag: 739a6450-5fda-44d0-88b0-325053d888c2
;;; viper-cmd.el ends here