;;; viper-cmd.el --- Vi command support for Viper
-;; Copyright (C) 1997 Free Software Foundation, Inc.
+
+;; Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
+;; 2005, 2006 Free Software Foundation, Inc.
+
+;; Author: Michael Kifer <kifer@cs.stonybrook.edu>
;; This file is part of GNU Emacs.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
+;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
+
+;;; Commentary:
-;; Code
+;;; Code:
(provide 'viper-cmd)
(require 'advice)
(defvar viper-always)
(defvar viper-mode-string)
(defvar viper-custom-file-name)
+(defvar viper--key-maps)
+(defvar viper--intercept-key-maps)
(defvar iso-accents-mode)
(defvar quail-mode)
(defvar quail-current-str)
(defvar zmacs-region-stays)
(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
;; given symbol foo, foo-p is the test function, foos is the set of
;; Viper command keys
;; (macroexpand '(viper-test-com-defun foo))
-;; (defun foo-p (com) (consp (memq (if (< com 0) (- com) com) foos)))
+;; (defun foo-p (com) (consp (memq com foos)))
(defmacro viper-test-com-defun (name)
(let* ((snm (symbol-name name))
(nm-p (intern (concat snm "-p")))
(nms (intern (concat snm "s"))))
`(defun ,nm-p (com)
- (consp (memq (if (and (viper-characterp com) (< com 0))
- (- com) com) ,nms)))))
+ (consp (viper-memq-char com ,nms)
+ ))))
;; Variables for defining VI commands
;; Modifying commands that can be prefixes to movement commands
-(defconst viper-prefix-commands '(?c ?d ?y ?! ?= ?# ?< ?> ?\"))
+(defvar viper-prefix-commands '(?c ?d ?y ?! ?= ?# ?< ?> ?\"))
;; define viper-prefix-command-p
(viper-test-com-defun viper-prefix-command)
;; Where viper saves mark. This mark is resurrected by m^
(defvar viper-saved-mark nil)
+;; Contains user settings for vars affected by viper-set-expert-level function.
+;; Not a user option.
+(defvar viper-saved-user-settings nil)
+
\f
;;; CODE
(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-move-marker-locally viper-insert-point viper-pre-command-point))
)
-(defsubst viper-insert-state-pre-command-sentinel ()
- (or (memq this-command '(self-insert-command))
+(defsubst viper-preserve-cursor-color ()
+ (or (memq this-command '(self-insert-command
+ viper-del-backward-char-in-insert
+ viper-del-backward-char-in-replace
+ viper-delete-backward-char
+ viper-join-lines
+ viper-delete-char))
(memq (viper-event-key last-command-event)
'(up down left right (meta f) (meta b)
- (control n) (control p) (control f) (control b)))
+ (control n) (control p) (control f) (control b)))))
+
+(defsubst viper-insert-state-pre-command-sentinel ()
+ (or (viper-preserve-cursor-color)
(viper-restore-cursor-color 'after-insert-mode))
(if (and (memq this-command '(dabbrev-expand hippie-expand))
(markerp viper-insert-point)
;; to speed up, don't change cursor color before self-insert
;; and common move commands
(defsubst viper-replace-state-pre-command-sentinel ()
- (or (memq this-command '(self-insert-command))
- (memq (viper-event-key last-command-event)
- '(up down left right (meta f) (meta b)
- (control n) (control p) (control f) (control b)))
+ (or (viper-preserve-cursor-color)
(viper-restore-cursor-color 'after-replace-mode)))
;; we set the point outside the replacement region, then the cursor color
;; will remain red. Restoring the default, below, fixes this problem.
;;
- ;; We optimize for self-insert-command's here, since they either don't change
+ ;; We optimize for some commands, like self-insert-command,
+ ;; viper-delete-backward-char, etc., since they either don't change
;; cursor color or, if they terminate replace mode, the color will be changed
;; in viper-finish-change
- (or (memq this-command '(self-insert-command))
+ (or (viper-preserve-cursor-color)
(viper-restore-cursor-color 'after-replace-mode))
(cond
((eq viper-current-state 'replace-state)
;; desirable that viper-pre-command-sentinel is the last hook and
;; viper-post-command-sentinel is the first hook.
- (make-local-hook 'viper-after-change-functions)
- (make-local-hook 'viper-before-change-functions)
- (make-local-hook 'viper-post-command-hooks)
- (make-local-hook 'viper-pre-command-hooks)
+ (viper-cond-compile-for-xemacs-or-emacs
+ ;; xemacs
+ (progn
+ (make-local-hook 'viper-after-change-functions)
+ (make-local-hook 'viper-before-change-functions)
+ (make-local-hook 'viper-post-command-hooks)
+ (make-local-hook 'viper-pre-command-hooks))
+ nil ; emacs
+ )
(remove-hook 'post-command-hook 'viper-post-command-sentinel)
(add-hook 'post-command-hook 'viper-post-command-sentinel)
'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))
;; This ensures that Viper bindings are in effect, regardless of which minor
;; modes were turned on by the user or by other packages.
(defun viper-normalize-minor-mode-map-alist ()
- (setq minor-mode-map-alist
- (viper-append-filter-alist
- (list (cons 'viper-vi-intercept-minor-mode viper-vi-intercept-map)
- (cons 'viper-vi-minibuffer-minor-mode viper-minibuffer-map)
- (cons 'viper-vi-local-user-minor-mode viper-vi-local-user-map)
- (cons 'viper-vi-kbd-minor-mode viper-vi-kbd-map)
- (cons 'viper-vi-global-user-minor-mode viper-vi-global-user-map)
- (cons '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-empty-keymap))
- (cons 'viper-vi-diehard-minor-mode viper-vi-diehard-map)
- (cons 'viper-vi-basic-minor-mode viper-vi-basic-map)
- (cons 'viper-insert-intercept-minor-mode
- viper-insert-intercept-map)
+ (setq viper--intercept-key-maps
+ (list
+ (cons 'viper-vi-intercept-minor-mode viper-vi-intercept-map)
+ (cons 'viper-insert-intercept-minor-mode viper-insert-intercept-map)
+ (cons 'viper-emacs-intercept-minor-mode viper-emacs-intercept-map)
+ ))
+ (setq viper--key-maps
+ (list (cons 'viper-vi-minibuffer-minor-mode viper-minibuffer-map)
+ (cons 'viper-vi-local-user-minor-mode viper-vi-local-user-map)
+ (cons 'viper-vi-kbd-minor-mode viper-vi-kbd-map)
+ (cons 'viper-vi-global-user-minor-mode viper-vi-global-user-map)
+ (cons '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-empty-keymap))
+ (cons 'viper-vi-diehard-minor-mode viper-vi-diehard-map)
+ (cons 'viper-vi-basic-minor-mode viper-vi-basic-map)
(cons 'viper-replace-minor-mode viper-replace-map)
;; viper-insert-minibuffer-minor-mode must come after
;; viper-replace-minor-mode
viper-empty-keymap))
(cons 'viper-insert-diehard-minor-mode viper-insert-diehard-map)
(cons 'viper-insert-basic-minor-mode viper-insert-basic-map)
- (cons 'viper-emacs-intercept-minor-mode
- viper-emacs-intercept-map)
(cons 'viper-emacs-local-user-minor-mode
viper-emacs-local-user-map)
(cons 'viper-emacs-kbd-minor-mode viper-emacs-kbd-map)
(cdr
(assoc major-mode viper-emacs-state-modifier-alist))
viper-empty-keymap))
- )
- minor-mode-map-alist)))
+ ))
+
+ ;; 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))
+ (set (make-local-variable 'minor-mode-map-alist)
+ (viper-append-filter-alist
+ (append viper--intercept-key-maps viper--key-maps)
+ minor-mode-map-alist)))
+ )
\f
;; 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)
(interactive)
(if (and viper-first-time (not (viper-is-in-minibuffer)))
(viper-mode)
- (if overwrite-mode (overwrite-mode nil))
+ (if overwrite-mode (overwrite-mode -1))
(or (viper-overlay-p viper-replace-overlay)
(viper-set-replace-overlay (point-min) (point-min)))
(viper-hide-replace-overlay)
(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
(viper-message-conditions conds))))
(defsubst viper-downgrade-to-insert ()
- (setq viper-current-state 'insert-state
- viper-replace-minor-mode nil))
+ ;; Protect against user errors in hooks
+ (condition-case conds
+ (run-hooks 'viper-insert-state-hook)
+ (error
+ (viper-message-conditions conds)))
+ (setq viper-current-state 'insert-state
+ viper-replace-minor-mode nil))
(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
ARG is used as the prefix value for the executed command. If
EVENTS is a list of events, which become the beginning of the command."
(interactive "P")
- (if (= last-command-char ?\\)
+ (if (viper= last-command-char ?\\)
(message "Switched to EMACS state for the next command..."))
(viper-escape-to-state arg events 'emacs-state))
viper-emacs-kbd-minor-mode)
(unwind-protect
(progn
- (setq com (key-binding (setq key
- (if viper-xemacs-p
- (read-key-sequence nil)
- (read-key-sequence nil t)))))
+ (setq com
+ (key-binding (setq key (viper-read-key-sequence nil))))
;; In case of binding indirection--chase definitions.
;; Have to do it here because we execute this command under
;; different keymaps, so command-execute may not do the
;; this-command, last-command-char, last-command-event
(setq this-command com)
- (if viper-xemacs-p ; XEmacs represents key sequences as vectors
- (setq last-command-event
- (viper-copy-event (viper-seq-last-elt key))
- last-command-char (event-to-character last-command-event))
- ;; Emacs represents them as sequences (str or vec)
- (setq last-command-event
- (viper-copy-event (viper-seq-last-elt key))
- last-command-char last-command-event))
+ (viper-cond-compile-for-xemacs-or-emacs
+ ;; XEmacs represents key sequences as vectors
+ (setq last-command-event
+ (viper-copy-event (viper-seq-last-elt key))
+ last-command-char (event-to-character last-command-event))
+ ;; Emacs represents them as sequences (str or vec)
+ (setq last-command-event
+ (viper-copy-event (viper-seq-last-elt key))
+ last-command-char last-command-event)
+ )
(if (commandp com)
- (progn
+ ;; pretend that current state is the state we excaped to
+ (let ((viper-current-state state))
(setq prefix-arg (or prefix-arg arg))
(command-execute com)))
)
;; set state in the new buffer
(viper-set-mode-vars-for viper-current-state))
+;; This is used in order to allow reading characters according to the input
+;; method. The character is read in emacs and inserted into the buffer.
+;; If an input method is in effect, this might
+;; cause several characters to be combined into one.
+;; Also takes care of the iso-accents mode
+(defun viper-special-read-and-insert-char ()
+ (viper-set-mode-vars-for 'emacs-state)
+ (viper-normalize-minor-mode-map-alist)
+ (if viper-special-input-method
+ (viper-set-input-method t))
+ (if viper-automatic-iso-accents
+ (viper-set-iso-accents-mode t))
+ (condition-case nil
+ (let (viper-vi-kbd-minor-mode
+ viper-insert-kbd-minor-mode
+ viper-emacs-kbd-minor-mode
+ ch)
+ (cond ((and viper-special-input-method
+ viper-emacs-p
+ (fboundp 'quail-input-method))
+ ;; (let ...) is used to restore unread-command-events to the
+ ;; original state. We don't want anything left in there after
+ ;; key translation. (Such left-overs are possible if the user
+ ;; types a regular key.)
+ (let (unread-command-events)
+ ;; 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-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-exclusive)))
+ (viper-set-unread-command-events ch)
+ (quail-input-method nil)
+
+ (if (and ch (string= quail-current-str ""))
+ (insert ch)
+ (insert quail-current-str))
+ (setq ch (or ch
+ (aref quail-current-str
+ (1- (length quail-current-str)))))
+ ))
+ ((and viper-special-input-method
+ viper-xemacs-p
+ (fboundp 'quail-start-translation))
+ ;; same as above but for XEmacs, which doesn't have
+ ;; quail-input-method
+ (let (unread-command-events)
+ (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-exclusive)))
+ (viper-set-unread-command-events ch)
+ (quail-start-translation nil)
+
+ (if (and ch (string= quail-current-str ""))
+ (insert ch)
+ (insert quail-current-str))
+ (setq ch (or ch
+ (aref quail-current-str
+ (1- (length quail-current-str)))))
+ ))
+ ((and (boundp 'iso-accents-mode) iso-accents-mode)
+ (setq ch (aref (read-key-sequence nil) 0))
+ ;; 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 (aref (read-key-sequence nil) 0)))
+ (insert ch))
+ (t
+ ;;(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))
+ (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
+ (viper-copy-event (if viper-xemacs-p
+ (character-to-event ch) ch)))
+ ) ; let
+ (error nil)
+ ) ; condition-case
+
+ (viper-set-input-method nil)
+ (viper-set-iso-accents-mode nil)
+ (viper-set-mode-vars-for viper-current-state)
+ )
+
+
(defun viper-exec-form-in-vi (form)
"Execute FORM in Vi state, regardless of the Ccurrent Vi state."
(let ((buff (current-buffer))
(viper-set-mode-vars-for viper-current-state)
result))
+;; This executes the last kbd event in emacs mode. Is used when we want to
+;; interpret certain keys directly in emacs (as, for example, in comint mode).
+(defun viper-exec-key-in-emacs (arg)
+ (interactive "P")
+ (viper-escape-to-emacs arg last-command-event))
+
;; This is needed because minor modes sometimes override essential Viper
;; bindings. By letting Viper know which files these modes are in, it will
;; Change the default for minor-mode-map-alist each time a harnessed minor
;; mode adds its own keymap to the a-list.
- (eval-after-load
- load-file '(setq-default minor-mode-map-alist minor-mode-map-alist))
+ (unless
+ (and (fboundp 'add-to-ordered-list) (boundp 'emulation-mode-map-alists))
+ (eval-after-load
+ load-file '(setq-default minor-mode-map-alist minor-mode-map-alist)))
)
(defun viper-envelop-ESC-key ()
(let ((event last-input-event)
(keyseq [nil])
- inhibit-quit)
+ (inhibit-quit t))
(if (viper-ESC-event-p event)
(progn
- (if (viper-fast-keysequence-p)
+ ;; 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)
+ (let (minor-mode-map-alist emulation-mode-map-alists)
(viper-set-unread-command-events event)
- (setq keyseq
- (funcall
- (ad-get-orig-definition 'read-key-sequence) nil))
+ (setq keyseq (read-key-sequence nil 'continue-echo))
) ; let
;; If keyseq translates into something that still has ESC
;; at the beginning, separate ESC from the rest of the seq.
(not viper-translate-all-ESC-keysequences))
;; put keys following ESC on the unread list
;; and return ESC as the key-sequence
- (viper-set-unread-command-events (subseq keyseq 1))
+ (viper-set-unread-command-events (viper-subseq keyseq 1))
(setq last-input-event event
keyseq (if viper-emacs-p
"\e"
(viper-set-unread-command-events
(vconcat (vector
(character-to-event (event-key first-key)))
- (subseq keyseq 1)))
+ (viper-subseq keyseq 1)))
(setq last-input-event event
keyseq (vector (character-to-event ?\e))))
((eventp first-key)
;; this is escape event with nothing after it
;; put in unread-command-event and then re-read
(viper-set-unread-command-events event)
- (setq keyseq
- (funcall (ad-get-orig-definition 'read-key-sequence) nil))
+ (setq keyseq (read-key-sequence nil))
))
;; not an escape event
(setq keyseq (vector event)))
;; call the actual function to execute ESC (if no other symbols followed)
;; or the key bound to the ESC sequence (if the sequence was issued
- ;; with very short delay between characters.
+ ;; with very short delay between characters).
(if (eq cmd 'viper-intercept-ESC-key)
(setq cmd
(cond ((eq viper-current-state 'vi-state)
;; Get com part of prefix-argument ARG and modify it.
(defun viper-getCom (arg)
(let ((com (viper-getcom arg)))
- (cond ((equal com ?c) ?c)
+ (cond ((viper= com ?c) ?c)
;; Previously, ?c was being converted to ?C, but this prevented
;; multiline replace regions.
- ;;((equal com ?c) ?C)
- ((equal com ?d) ?D)
- ((equal com ?y) ?Y)
+ ;;((viper= com ?c) ?C)
+ ((viper= com ?d) ?D)
+ ((viper= com ?y) ?Y)
(t com))))
;; Compute numeric prefix arg value.
-;; Invoked by EVENT. COM is the command part obtained so far.
+;; Invoked by EVENT-CHAR. COM is the command part obtained so far.
(defun viper-prefix-arg-value (event-char com)
(let ((viper-intermediate-command 'viper-digit-argument)
value func)
cmd-info
cmd-to-exec-at-end)
(while (and cont
- (memq char
- (list ?c ?d ?y ?! ?< ?> ?= ?# ?r ?R ?\"
- viper-buffer-search-char)))
+ (viper-memq-char char
+ (list ?c ?d ?y ?! ?< ?> ?= ?# ?r ?R ?\"
+ viper-buffer-search-char)))
(if com
;; this means that we already have a command character, so we
;; construct a com list and exit while. however, if char is "
;; it is an error.
(progn
;; new com is (CHAR . OLDCOM)
- (if (memq char '(?# ?\")) (error ""))
+ (if (viper-memq-char char '(?# ?\")) (error ""))
(setq com (cons char com))
(setq cont nil))
;; If com is nil we set com as char, and read more. Again, if char is
;; ", we read the name of register and store it in viper-use-register.
;; if char is !, =, or #, a complete com is formed so we exit the while
;; loop.
- (cond ((memq char '(?! ?=))
+ (cond ((viper-memq-char char '(?! ?=))
(setq com char)
(setq char (read-char))
(setq cont nil))
- ((= char ?#)
+ ((viper= char ?#)
;; read a char and encode it as com
(setq com (+ 128 (read-char)))
(setq char (read-char)))
- ((= char ?\")
+ ((viper= char ?\")
(let ((reg (read-char)))
(if (viper-valid-register reg)
(setq viper-use-register reg)
(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 (= 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)
- (= char ?!) ; bang command
- (error ""))
- (setq cmd-to-exec-at-end
- (viper-exec-form-in-vi
- `(key-binding (char-to-string ,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
+ (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 "")))))
- ;; as com is non-nil, this means that we have a command to execute
- (if (memq (car com) '(?r ?R))
- ;; execute apropriate region command.
- (let ((char (car com)) (com (cdr com)))
- (setq prefix-arg (cons value com))
- (if (= 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 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)
(exchange-point-and-mark))
(if (eq (preceding-char) ?\n)
(viper-backward-char-carefully)) ; give back the newline
- (if (= com ?c)
- (viper-change (mark t) (point))
- (viper-change-subr (mark t) (point))))
+ (if (eq viper-intermediate-command 'viper-repeat)
+ (viper-change-subr (mark t) (point))
+ (viper-change (mark t) (point))
+ ))
;; this is invoked by viper-substitute-line
(defun viper-exec-Change (m-com com)
(setq viper-use-register nil)))
(delete-region (mark t) (point)))
(open-line 1)
- (if (= com ?C)
- (viper-change-state-to-insert)
- (viper-yank-last-insertion)))
+ (if (eq viper-intermediate-command 'viper-repeat)
+ (viper-yank-last-insertion)
+ (viper-change-state-to-insert)
+ ))
(defun viper-exec-delete (m-com com)
(or (and (markerp viper-com-point) (marker-position viper-com-point))
(if (eq last-command 'd-command) 'kill-region nil))
(setq chars-deleted (abs (- (point) viper-com-point)))
(if (> chars-deleted viper-change-notification-threshold)
- (message "Deleted %d characters" chars-deleted))
+ (unless (viper-is-in-minibuffer)
+ (message "Deleted %d characters" chars-deleted)))
(kill-region viper-com-point (point))
(setq this-command 'd-command)
(if viper-ex-style-motion
(if (eq last-command 'D-command) 'kill-region nil))
(setq lines-deleted (count-lines (point) viper-com-point))
(if (> lines-deleted viper-change-notification-threshold)
- (message "Deleted %d lines" lines-deleted))
+ (unless (viper-is-in-minibuffer)
+ (message "Deleted %d lines" lines-deleted)))
(kill-region (mark t) (point))
(if (eq m-com 'viper-line) (setq this-command 'D-command)))
(back-to-indentation)))
(copy-region-as-kill viper-com-point (point))
(setq chars-saved (abs (- (point) viper-com-point)))
(if (> chars-saved viper-change-notification-threshold)
- (message "Saved %d characters" chars-saved))
+ (unless (viper-is-in-minibuffer)
+ (message "Saved %d characters" chars-saved)))
(goto-char viper-com-point)))
;; save lines
(copy-region-as-kill (mark t) (point))
(setq lines-saved (count-lines (mark t) (point)))
(if (> lines-saved viper-change-notification-threshold)
- (message "Saved %d lines" lines-saved))))
+ (unless (viper-is-in-minibuffer)
+ (message "Saved %d lines" lines-saved)))))
(viper-deactivate-mark)
(goto-char viper-com-point))
(exchange-point-and-mark)
(shell-command-on-region
(mark t) (point)
- (if (= com ?!)
+ (if (viper= com ?!)
(setq viper-last-shell-com
(viper-read-string-with-history
"!"
(viper-enlarge-region (mark t) (point))
(if (> (mark t) (point)) (exchange-point-and-mark))
(indent-rigidly (mark t) (point)
- (if (= com ?>)
+ (if (viper= com ?>)
viper-shift-width
(- viper-shift-width))))
;; return point to where it was before shift
nil)
(defun viper-exec-buffer-search (m-com com)
- (setq viper-s-string (buffer-substring (point) viper-com-point))
+ (setq viper-s-string
+ (regexp-quote (buffer-substring (point) viper-com-point)))
(setq viper-s-forward t)
(setq viper-search-history (cons viper-s-string viper-search-history))
(setq viper-intermediate-command 'viper-exec-buffer-search)
;; this is the special command `#'
(if (> com 128)
(viper-special-prefix-com (- com 128))
- (let ((fn (aref viper-exec-array (if (< com 0) (- com) com))))
+ (let ((fn (aref viper-exec-array com)))
(if (null fn)
(error "%c: %s" com viper-InvalidViCommand)
(funcall fn m-com com))))
(if (viper-dotable-command-p com)
(viper-set-destructive-command
- (list m-com val
- (if (memq com (list ?c ?C ?!)) (- com) com)
- reg nil nil)))
+ (list m-com val com reg nil nil)))
))
(com (nth 2 viper-d-com))
(reg (nth 3 viper-d-com)))
(if (null val) (setq val (nth 1 viper-d-com)))
- (if (null m-com) (error "No previous command to repeat."))
+ (if (null m-com) (error "No previous command to repeat"))
(setq viper-use-register reg)
(if (nth 4 viper-d-com) ; text inserted by command
(setq viper-last-insertion (nth 4 viper-d-com)
;; The hash-command. It is invoked interactively by the key sequence #<char>.
;; The chars that can follow `#' are determined by viper-hash-command-p
(defun viper-special-prefix-com (char)
- (cond ((= char ?c)
+ (cond ((viper= char ?c)
(downcase-region (min viper-com-point (point))
(max viper-com-point (point))))
- ((= char ?C)
+ ((viper= char ?C)
(upcase-region (min viper-com-point (point))
(max viper-com-point (point))))
- ((= char ?g)
+ ((viper= char ?g)
(push-mark viper-com-point t)
+ ;; execute the last emacs kbd macro on each line of the region
(viper-global-execute))
- ((= char ?q)
+ ((viper= char ?q)
(push-mark viper-com-point t)
(viper-quote-region))
- ((= char ?s) (funcall viper-spell-function viper-com-point (point)))
+ ((viper= char ?s)
+ (funcall viper-spell-function viper-com-point (point)))
(t (error "#%c: %s" char viper-InvalidViCommand))))
\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))
(message " `.' runs %s%s"
(concat "`" (viper-array-to-string keys) "'")
(viper-abbreviate-string
- (if viper-xemacs-p
- (replace-in-string
- (cond ((characterp text) (char-to-string text))
- ((stringp text) text)
- (t ""))
- "\n" "^J")
- text)
+ (viper-cond-compile-for-xemacs-or-emacs
+ (replace-in-string ; xemacs
+ (cond ((characterp text) (char-to-string text))
+ ((stringp text) text)
+ (t ""))
+ "\n" "^J")
+ text ; emacs
+ )
max-text-len
" inserting `" "'" " ......."))
))
(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 ()
(let ((hook (if viper-vi-style-in-minibuffer
'viper-change-state-to-insert
'viper-change-state-to-emacs)))
+ ;; making buffer-local variables so that normal buffers won't affect the
+ ;; minibuffer and vice versa. Otherwise, command arguments will affect
+ ;; minibuffer ops and insertions from the minibuffer will change those in
+ ;; the normal buffers
+ (make-local-variable 'viper-d-com)
+ (make-local-variable 'viper-last-insertion)
+ (make-local-variable 'viper-command-ring)
+ (setq viper-d-com nil
+ viper-last-insertion nil
+ viper-command-ring nil)
(funcall hook)
))
;; Thie is a temp hook that uses free variables init-message and initial.
;; A dirty feature, but it is the simplest way to have it do the right thing.
-;; The init-message and initial vars come from the scope set by
+;; The INIT-MESSAGE and INITIAL vars come from the scope set by
;; viper-read-string-with-history
(defun viper-minibuffer-standard-hook ()
(if (stringp init-message)
(if (fboundp 'minibuffer-prompt-end)
(delete-region (minibuffer-prompt-end) (point-max))
(erase-buffer))
- (insert initial)))
- (viper-minibuffer-setup-sentinel))
+ (insert initial))))
(defsubst viper-minibuffer-real-start ()
(if (fboundp 'minibuffer-prompt-end)
(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.
(defcustom viper-smart-suffix-list
- '("" "tex" "c" "cc" "C" "el" "java" "html" "htm" "pl" "flr" "P" "p")
+ '("" "tex" "c" "cc" "C" "java" "el" "html" "htm" "xml"
+ "pl" "flr" "P" "p" "h" "H")
"*List of suffixes that Viper tries to append to filenames ending with a `.'.
-This is useful when you the current directory contains files with the same
+This is useful when the current directory contains files with the same
prefix and many different suffixes. Usually, only one of the suffixes
represents an editable file. However, file completion will stop at the `.'
The smart suffix feature lets you hit RET in such a case, and Viper will
(setq cmd
(key-binding (setq key (read-key-sequence nil))))
(cond ((eq cmd 'self-insert-command)
- (if viper-xemacs-p
- (insert (events-to-keys key))
- (insert key)))
+ (viper-cond-compile-for-xemacs-or-emacs
+ (insert (events-to-keys key)) ; xemacs
+ (insert key) ; emacs
+ ))
((memq cmd '(exit-minibuffer viper-exit-minibuffer))
nil)
(t (command-execute cmd)))
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)))))
;; KEYMAP is used, if given, instead of minibuffer-local-map.
;; INIT-MESSAGE is the message temporarily displayed after entering the
;; minibuffer.
- (let ((minibuffer-setup-hook 'viper-minibuffer-standard-hook)
+ (let ((minibuffer-setup-hook
+ ;; stolen from add-hook
+ (let ((old
+ (if (boundp 'minibuffer-setup-hook)
+ minibuffer-setup-hook
+ nil)))
+ (cons
+ 'viper-minibuffer-standard-hook
+ (if (or (not (listp old)) (eq (car old) 'lambda))
+ (list old) old))))
(val "")
(padding "")
temp-msg)
(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)
(interactive "P")
(viper-set-complex-command-for-undo)
(let ((val (viper-p-val arg))
- (com (viper-getcom arg)))
+ ;;(com (viper-getcom arg))
+ )
(viper-set-destructive-command (list 'viper-insert val ?r nil nil nil))
- (if com
+ (if (eq viper-intermediate-command 'viper-repeat)
(viper-loop val (viper-yank-last-insertion))
(viper-change-state-to-insert))))
(interactive "P")
(viper-set-complex-command-for-undo)
(let ((val (viper-p-val arg))
- (com (viper-getcom arg)))
+ ;;(com (viper-getcom arg))
+ )
(viper-set-destructive-command (list 'viper-append val ?r nil nil nil))
(if (not (eolp)) (forward-char))
- (if (equal com ?r)
+ (if (eq viper-intermediate-command 'viper-repeat)
(viper-loop val (viper-yank-last-insertion))
(viper-change-state-to-insert))))
(interactive "P")
(viper-set-complex-command-for-undo)
(let ((val (viper-p-val arg))
- (com (viper-getcom arg)))
+ ;;(com (viper-getcom arg))
+ )
(viper-set-destructive-command (list 'viper-Append val ?r nil nil nil))
(end-of-line)
- (if (equal com ?r)
+ (if (eq viper-intermediate-command 'viper-repeat)
(viper-loop val (viper-yank-last-insertion))
(viper-change-state-to-insert))))
(interactive "P")
(viper-set-complex-command-for-undo)
(let ((val (viper-p-val arg))
- (com (viper-getcom arg)))
+ ;;(com (viper-getcom arg))
+ )
(viper-set-destructive-command (list 'viper-Insert val ?r nil nil nil))
(back-to-indentation)
- (if (equal com ?r)
+ (if (eq viper-intermediate-command 'viper-repeat)
(viper-loop val (viper-yank-last-insertion))
(viper-change-state-to-insert))))
(interactive "P")
(viper-set-complex-command-for-undo)
(let ((val (viper-p-val arg))
- (com (viper-getcom arg)))
+ ;;(com (viper-getcom arg))
+ )
(viper-set-destructive-command (list 'viper-open-line val ?r nil nil nil))
(let ((col (current-indentation)))
- (if (equal com ?r)
+ (if (eq viper-intermediate-command 'viper-repeat)
(viper-loop val
(end-of-line)
(newline 1)
- (if viper-auto-indent
- (progn
- (setq viper-cted t)
- (if viper-electric-mode
- (indent-according-to-mode)
- (indent-to col))
- ))
+ (viper-indent-line col)
(viper-yank-last-insertion))
(end-of-line)
(newline 1)
- (if viper-auto-indent
- (progn
- (setq viper-cted t)
- (if viper-electric-mode
- (indent-according-to-mode)
- (indent-to col))))
+ (viper-indent-line col)
(viper-change-state-to-insert)))))
(defun viper-Open-line (arg)
(interactive "P")
(viper-set-complex-command-for-undo)
(let ((val (viper-p-val arg))
- (com (viper-getcom arg)))
+ ;;(com (viper-getcom arg))
+ )
(viper-set-destructive-command (list 'viper-Open-line val ?r nil nil nil))
(let ((col (current-indentation)))
- (if (equal com ?r)
+ (if (eq viper-intermediate-command 'viper-repeat)
(viper-loop val
(beginning-of-line)
(open-line 1)
- (if viper-auto-indent
- (progn
- (setq viper-cted t)
- (if viper-electric-mode
- (indent-according-to-mode)
- (indent-to col))
- ))
+ (viper-indent-line col)
(viper-yank-last-insertion))
(beginning-of-line)
(open-line 1)
- (if viper-auto-indent
- (progn
- (setq viper-cted t)
- (if viper-electric-mode
- (indent-according-to-mode)
- (indent-to col))
- ))
+ (viper-indent-line col)
(viper-change-state-to-insert)))))
(defun viper-open-line-at-point (arg)
(interactive "P")
(viper-set-complex-command-for-undo)
(let ((val (viper-p-val arg))
- (com (viper-getcom arg)))
+ ;;(com (viper-getcom arg))
+ )
(viper-set-destructive-command
(list 'viper-open-line-at-point val ?r nil nil nil))
- (if (equal com ?r)
+ (if (eq viper-intermediate-command 'viper-repeat)
(viper-loop val
(open-line 1)
(viper-yank-last-insertion))
(open-line 1)
(viper-change-state-to-insert))))
+;; bound to s
(defun viper-substitute (arg)
"Substitute characters."
(interactive "P")
(let ((val (viper-p-val arg))
- (com (viper-getcom arg)))
+ ;;(com (viper-getcom arg))
+ )
(push-mark nil t)
(forward-char val)
- (if (equal com ?r)
+ (if (eq viper-intermediate-command 'viper-repeat)
(viper-change-subr (mark t) (point))
(viper-change (mark t) (point)))
+ ;; com is set to ?r when we repeat this comand with dot
(viper-set-destructive-command (list 'viper-substitute val ?r nil nil nil))
))
;; guard against a smartie who switched from R-replace to normal replace
(remove-hook
'viper-post-command-hooks 'viper-R-state-post-command-sentinel 'local)
- (if overwrite-mode (overwrite-mode nil))
+ (if overwrite-mode (overwrite-mode -1))
)
(if (eq this-command 'viper-intercept-ESC-key)
(setq com 'viper-exit-insert-state)
(viper-set-unread-command-events last-input-char)
- (setq com (key-binding (read-key-sequence nil))))
+ (setq com (key-binding (viper-read-key-sequence nil))))
(condition-case conds
(command-execute com)
"Begin overwrite mode."
(interactive "P")
(let ((val (viper-p-val arg))
- (com (viper-getcom arg)) (len))
+ ;;(com (viper-getcom arg))
+ (len))
(viper-set-destructive-command (list 'viper-overwrite val ?r nil nil nil))
- (if com
+ (if (eq viper-intermediate-command 'viper-repeat)
(progn
;; Viper saves inserted text in viper-last-insertion
(setq len (length viper-last-insertion))
- (delete-char len)
+ (delete-char (min len (- (point-max) (point) 1)))
(viper-loop val (viper-yank-last-insertion)))
(setq last-command 'viper-overwrite)
(viper-set-complex-command-for-undo)
;; 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)
))
(defun viper-replace-char-subr (com arg)
- (let (char)
- (setq char (if (equal com ?r)
- viper-d-char
- (read-char)))
- (let (inhibit-quit) ; preserve consistency of undo-list and iso-accents
- (if (and viper-automatic-iso-accents (memq char '(?' ?\" ?^ ?~)))
- ;; get European characters
- (progn
- (viper-set-iso-accents-mode t)
- (viper-set-unread-command-events char)
- (setq char (aref (read-key-sequence nil) 0))
- (viper-set-iso-accents-mode nil)))
- (viper-set-complex-command-for-undo)
- (if (eq char ?\C-m) (setq char ?\n))
- (if (and viper-special-input-method (fboundp 'quail-start-translation))
- ;; get Intl. characters
- (progn
- (viper-set-input-method t)
- (setq last-command-event
- (viper-copy-event
- (if viper-xemacs-p (character-to-event char) char)))
- (delete-char 1 t)
- (condition-case nil
- (if com
- (insert char)
- (if viper-emacs-p
- (quail-start-translation 1)
- (quail-start-translation)))
- (error))
- ;; quail translation failed
- (if (and (not (stringp quail-current-str))
- (not (viper-characterp quail-current-str)))
- (progn
- (viper-adjust-undo)
- (undo-start)
- (undo-more 1)
- (viper-set-input-method nil)
- (error "Composing character failed, changes undone")))
- ;; quail translation seems ok
- (or com
- ;;(setq char quail-current-str))
- (setq char (viper-char-at-pos 'backward)))
- (setq viper-d-char char)
- (viper-loop (1- (if (> arg 0) arg (- arg)))
- (delete-char 1 t)
- (insert char))
- (viper-set-input-method nil))
- (delete-char arg t)
- (setq viper-d-char char)
- (viper-loop (if (> arg 0) arg (- arg))
- (insert char)))
- (viper-adjust-undo)
- (backward-char arg))))
+ (let ((inhibit-quit t)
+ char)
+ (viper-set-complex-command-for-undo)
+ (or (eq viper-intermediate-command 'viper-repeat)
+ (viper-special-read-and-insert-char))
+
+ (delete-char 1 t)
+ (setq char (if com viper-d-char (viper-char-at-pos 'backward)))
+
+ (if com (insert char))
+
+ (setq viper-d-char char)
+
+ (viper-loop (1- (if (> arg 0) arg (- arg)))
+ (delete-char 1 t)
+ (insert char))
+
+ (viper-adjust-undo)
+ (backward-char arg)
+ ))
\f
;; basic cursor movement. j, k, l, h commands.
(let ((pt (point)))
(condition-case nil
(forward-char arg)
- (error))
+ (error nil))
(if (< (point) pt) ; arg was negative
(- (viper-chars-in-region pt (point)))
(viper-chars-in-region pt (point)))))
(let ((pt (point)))
(condition-case nil
(backward-char arg)
- (error))
+ (error nil))
(if (> (point) pt) ; arg was negative
(viper-chars-in-region pt (point))
(- (viper-chars-in-region pt (point))))))
(viper-backward-char-carefully)
(if (looking-at "\n")
(viper-skip-all-separators-backward 'within-line)
- (or (bobp) (forward-char)))))
+ (or (viper-looking-at-separator) (forward-char)))))
(defun viper-forward-word-kernel (val)
(let ((prev-char (viper-char-at-pos 'backward))
(saved-point (point)))
;; skip non-newline separators backward
- (while (and (not (memq prev-char '(nil \n)))
+ (while (and (not (viper-memq-char prev-char '(nil \n)))
(< lim (point))
;; must be non-newline separator
(if (eq viper-syntax-preference 'strict-vi)
- (memq prev-char '(?\ ?\t))
- (memq (char-syntax prev-char) '(?\ ?-))))
+ (viper-memq-char prev-char '(?\ ?\t))
+ (viper-memq-char (char-syntax prev-char) '(?\ ?-))))
(viper-backward-char-carefully)
(setq prev-char (viper-char-at-pos 'backward)))
;; skip again, but make sure we don't overshoot the limit
(if twice
- (while (and (not (memq prev-char '(nil \n)))
+ (while (and (not (viper-memq-char prev-char '(nil \n)))
(< lim (point))
;; must be non-newline separator
(if (eq viper-syntax-preference 'strict-vi)
- (memq prev-char '(?\ ?\t))
- (memq (char-syntax prev-char) '(?\ ?-))))
+ (viper-memq-char prev-char '(?\ ?\t))
+ (viper-memq-char (char-syntax prev-char) '(?\ ?-))))
(viper-backward-char-carefully)
(setq prev-char (viper-char-at-pos 'backward))))
(com (viper-getcom arg)))
(if com (viper-move-marker-locally 'viper-com-point (point)))
(viper-forward-word-kernel val)
- (if com (progn
- (cond ((memq com (list ?c (- ?c)))
- (viper-separator-skipback-special 'twice viper-com-point))
- ;; Yank words including the whitespace, but not newline
- ((memq com (list ?y (- ?y)))
- (viper-separator-skipback-special nil viper-com-point))
- ((viper-dotable-command-p com)
- (viper-separator-skipback-special nil viper-com-point)))
- (viper-execute-com 'viper-forward-word val com)))))
+ (if com
+ (progn
+ (cond ((viper-char-equal com ?c)
+ (viper-separator-skipback-special 'twice viper-com-point))
+ ;; Yank words including the whitespace, but not newline
+ ((viper-char-equal com ?y)
+ (viper-separator-skipback-special nil viper-com-point))
+ ((viper-dotable-command-p com)
+ (viper-separator-skipback-special nil viper-com-point)))
+ (viper-execute-com 'viper-forward-word val com)))
+ ))
(defun viper-forward-Word (arg)
(viper-skip-nonseparators 'forward)
(viper-skip-separators t))
(if com (progn
- (cond ((memq com (list ?c (- ?c)))
+ (cond ((viper-char-equal com ?c)
(viper-separator-skipback-special 'twice viper-com-point))
;; Yank words including the whitespace, but not newline
- ((memq com (list ?y (- ?y)))
+ ((viper-char-equal com ?y)
(viper-separator-skipback-special nil viper-com-point))
((viper-dotable-command-p com)
(viper-separator-skipback-special nil viper-com-point)))
(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)
(defun viper-find-char-forward (arg)
"Find char on the line.
If called interactively read the char to find from the terminal, and if
-called from viper-repeat, the char last used is used. This behaviour is
+called from viper-repeat, the char last used is used. This behavior is
controlled by the sign of prefix numeric value."
(interactive "P")
(let ((val (viper-p-val arg))
;; (which is called from viper-search-forward/backward/next). If the value of
;; viper-search-scroll-threshold is negative - don't scroll.
(defun viper-adjust-window ()
- (let ((win-height (if viper-emacs-p
- (1- (window-height)) ; adjust for modeline
- (window-displayed-height)))
+ (let ((win-height (viper-cond-compile-for-xemacs-or-emacs
+ (window-displayed-height) ; xemacs
+ ;; emacs
+ (1- (window-height)) ; adjust for modeline
+ ))
(pt (point))
at-top-p at-bottom-p
min-scroll direction)
(setq msg "Search style remains unchanged")))
(princ msg t)))
-(defun viper-set-searchstyle-toggling-macros (unset)
+(defun viper-set-searchstyle-toggling-macros (unset &optional major-mode)
"Set the macros for toggling the search style in Viper's vi-state.
The macro that toggles case sensitivity is bound to `//', and the one that
toggles regexp search is bound to `///'.
-With a prefix argument, this function unsets the macros. "
+With a prefix argument, this function unsets the macros.
+If MAJOR-MODE is set, set the macros only in that major mode."
(interactive "P")
- (or noninteractive
- (if (not unset)
- (progn
- ;; toggle case sensitivity in search
- (viper-record-kbd-macro
- "//" 'vi-state
- [1 (meta x) v i p e r - t o g g l e - s e a r c h - s t y l e return]
- 't)
- ;; toggle regexp/vanila search
- (viper-record-kbd-macro
- "///" 'vi-state
- [2 (meta x) v i p e r - t o g g l e - s e a r c h - s t y l e return]
- 't)
- (if (interactive-p)
- (message
- "// and /// now toggle case-sensitivity and regexp search")))
- (viper-unrecord-kbd-macro "//" 'vi-state)
- (sit-for 2)
- (viper-unrecord-kbd-macro "///" 'vi-state))))
+ (let (scope)
+ (if (and major-mode (symbolp major-mode))
+ (setq scope major-mode)
+ (setq scope 't))
+ (or noninteractive
+ (if (not unset)
+ (progn
+ ;; toggle case sensitivity in search
+ (viper-record-kbd-macro
+ "//" 'vi-state
+ [1 (meta x) v i p e r - t o g g l e - s e a r c h - s t y l e return]
+ scope)
+ ;; toggle regexp/vanila search
+ (viper-record-kbd-macro
+ "///" 'vi-state
+ [2 (meta x) v i p e r - t o g g l e - s e a r c h - s t y l e return]
+ scope)
+ (if (interactive-p)
+ (message
+ "// and /// now toggle case-sensitivity and regexp search")))
+ (viper-unrecord-kbd-macro "//" 'vi-state)
+ (sit-for 2)
+ (viper-unrecord-kbd-macro "///" 'vi-state)))
+ ))
(defun viper-set-parsing-style-toggling-macro (unset)
(interactive "P")
(let ((val (viper-P-val arg))
(com (viper-getcom arg))
- (old-str viper-s-string))
+ (old-str viper-s-string)
+ debug-on-error)
(setq viper-s-forward t)
(viper-if-string "/")
;; this is not used at present, but may be used later
(if com
(progn
(viper-move-marker-locally 'viper-com-point (mark t))
- (viper-execute-com 'viper-search-next val com)))))
+ (viper-execute-com 'viper-search-next val com)))
+ ))
(defun viper-search-backward (arg)
"Search a string backward.
(interactive "P")
(let ((val (viper-P-val arg))
(com (viper-getcom arg))
- (old-str viper-s-string))
+ (old-str viper-s-string)
+ debug-on-error)
(setq viper-s-forward nil)
(viper-if-string "?")
;; this is not used at present, but may be used later
"Repeat previous search."
(interactive "P")
(let ((val (viper-p-val arg))
- (com (viper-getcom arg)))
- (if (null viper-s-string) (error viper-NoPrevSearch))
+ (com (viper-getcom arg))
+ debug-on-error)
+ (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
"Repeat previous search in the reverse direction."
(interactive "P")
(let ((val (viper-p-val arg))
- (com (viper-getcom arg)))
+ (com (viper-getcom arg))
+ debug-on-error)
(if (null viper-s-string) (error viper-NoPrevSearch))
(viper-search viper-s-string (not viper-s-forward) arg)
(if com
(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)
(char-to-string viper-buffer-search-char))
- (t (error "viper-buffer-search-char: wrong value type, %s"
+ (t (error "viper-buffer-search-char: wrong value type, %S"
viper-buffer-search-char)))
'viper-command-argument)
(aset viper-exec-array viper-buffer-search-char 'viper-exec-buffer-search)
lines-inserted (abs (count-lines (point) sv-point)))
(if (or (> chars-inserted viper-change-notification-threshold)
(> lines-inserted viper-change-notification-threshold))
- (message "Inserted %d character(s), %d line(s)"
- chars-inserted lines-inserted)))
+ (unless (viper-is-in-minibuffer)
+ (message "Inserted %d character(s), %d line(s)"
+ chars-inserted lines-inserted))))
;; Vi puts cursor on the last char when the yanked text doesn't contain a
;; newline; it leaves the cursor at the beginning when the text contains
;; a newline
lines-inserted (abs (count-lines (point) sv-point)))
(if (or (> chars-inserted viper-change-notification-threshold)
(> lines-inserted viper-change-notification-threshold))
- (message "Inserted %d character(s), %d line(s)"
- chars-inserted lines-inserted)))
+ (unless (viper-is-in-minibuffer)
+ (message "Inserted %d character(s), %d line(s)"
+ chars-inserted lines-inserted))))
;; Vi puts cursor on the last char when the yanked text doesn't contain a
;; newline; it leaves the cursor at the beginning when the text contains
;; a newline
(interactive)
(if (and viper-ex-style-editing (bolp))
(beep 1)
- (delete-backward-char 1 t)))
+ ;; don't put on kill ring
+ (delete-backward-char 1 nil)))
(defun viper-del-backward-char-in-replace ()
(interactive)
(cond (viper-delete-backwards-in-replace
(cond ((not (bolp))
- (delete-backward-char 1 t))
+ ;; don't put on kill ring
+ (delete-backward-char 1 nil))
(viper-ex-style-editing
(beep 1))
((bobp)
(beep 1))
(t
- (delete-backward-char 1 t))))
+ ;; don't put on kill ring
+ (delete-backward-char 1 nil))))
(viper-ex-style-editing
(if (bolp)
(beep 1)
(interactive)
(let ((char (read-char)))
(cond ((and (<= ?a char) (<= char ?z))
- (point-to-register (1+ (- char ?a))))
- ((= char ?<) (viper-mark-beginning-of-buffer))
- ((= char ?>) (viper-mark-end-of-buffer))
- ((= char ?.) (viper-set-mark-if-necessary))
- ((= char ?,) (viper-cycle-through-mark-ring))
- ((= char ?^) (push-mark viper-saved-mark t t))
- ((= char ?D) (mark-defun))
+ (point-to-register (viper-int-to-char (1+ (- char ?a)))))
+ ((viper= char ?<) (viper-mark-beginning-of-buffer))
+ ((viper= char ?>) (viper-mark-end-of-buffer))
+ ((viper= char ?.) (viper-set-mark-if-necessary))
+ ((viper= char ?,) (viper-cycle-through-mark-ring))
+ ((viper= char ?^) (push-mark viper-saved-mark t t))
+ ((viper= char ?D) (mark-defun))
(t (error ""))
)))
(backward-char 1)))
(cond ((viper-valid-register char '(letter))
(let* ((buff (current-buffer))
- (reg (1+ (- char ?a)))
+ (reg (viper-int-to-char (1+ (- char ?a))))
(text-marker (get-register reg)))
;; If marker points to file that had markers set (and those markers
;; were saved (as e.g., in session.el), then restore those markers
(goto-char viper-com-point)
(viper-change-state-to-vi)
(error "")))))
- ((and (not skip-white) (= char ?`))
+ ((and (not skip-white) (viper= char ?`))
(if com (viper-move-marker-locally 'viper-com-point (point)))
(if (and (viper-same-line (point) viper-last-jump)
(= (point) viper-last-jump-ignore))
(setq viper-last-jump (point-marker)
viper-last-jump-ignore 0)
(if com (viper-execute-com 'viper-goto-mark nil com)))
- ((and skip-white (= char ?'))
+ ((and skip-white (viper= char ?'))
(if com (viper-move-marker-locally 'viper-com-point (point)))
(if (and (viper-same-line (point) viper-last-jump)
(= (point) viper-last-jump-ignore))
(if (or (bolp) (viper-looking-back "[^ \t]"))
(setq viper-cted nil)))))
+;; do smart indent
+(defun viper-indent-line (col)
+ (if viper-auto-indent
+ (progn
+ (setq viper-cted t)
+ (if (and viper-electric-mode
+ (not (memq major-mode '(fundamental-mode
+ text-mode
+ paragraph-indent-text-mode))))
+ (indent-according-to-mode)
+ (indent-to col)))))
+
+
(defun viper-autoindent ()
"Auto Indentation, Vi-style."
(interactive)
;; use \n instead of newline, or else <Return> will move the insert point
;;(newline 1)
(insert "\n")
- (if viper-auto-indent
- (progn
- (setq viper-cted t)
- (if (and viper-electric-mode
- (not
- (memq major-mode '(fundamental-mode
- text-mode
- paragraph-indent-text-mode ))))
- (indent-according-to-mode)
- (indent-to viper-current-indent))
- ))
+ (viper-indent-line viper-current-indent)
))
(princ (format "Register %c contains the string:\n" reg))
(princ text))
))
- ((= ?\] reg)
+ ((viper= ?\] reg)
(viper-next-heading arg))
(t (error
viper-InvalidRegister reg)))))
"Function called by \[, the brac. View textmarkers and call \[\["
(interactive "P")
(let ((reg (read-char)))
- (cond ((= ?\[ reg)
+ (cond ((viper= ?\[ reg)
(viper-prev-heading arg))
- ((= ?\] reg)
+ ((viper= ?\] reg)
(viper-heading-end arg))
((viper-valid-register reg '(letter))
- (let* ((val (get-register (1+ (- reg ?a))))
+ (let* ((val (get-register (viper-int-to-char (1+ (- reg ?a)))))
(buf (if (not (markerp val))
(error viper-EmptyTextmarker reg)
(marker-buffer val)))
(t (error viper-InvalidTextmarker reg)))))
-\f
-;; commands in insertion mode
(defun viper-delete-backward-word (arg)
"Delete previous word."
(delete-region (point) (mark t))
(pop-mark)))
+\f
+
+;; Get viper standard value of SYMBOL. If symbol is customized, get its
+;; standard value. Otherwise, get the value saved in the alist STORAGE. If
+;; STORAGE is nil, use viper-saved-user-settings.
+(defun viper-standard-value (symbol &optional storage)
+ (or (eval (car (get symbol 'customized-value)))
+ (eval (car (get symbol 'saved-value)))
+ (nth 1 (assoc symbol (or storage viper-saved-user-settings)))))
+
+
(defun viper-set-expert-level (&optional dont-change-unless)
"Sets the expert level for a Viper user.
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.
2 -- MASTER: C-c now has its standard Emacs meaning in Vi command state,
so most Emacs commands can be used when Viper is in Vi state.
Good progress---you are well on the way to level 3!
- 3 -- GRAND MASTER: Like 3, but most Emacs commands are available also
+ 3 -- GRAND MASTER: Like 2, but most Emacs commands are available also
in Viper's insert state.
4 -- GURU: Like 3, but user settings are respected for viper-no-multiple-ESC,
viper-ex-style-motion, viper-ex-style-editing, and
(if (and enforce-buffer
(not (equal (current-buffer) (marker-buffer val))))
(error (concat viper-EmptyTextmarker " in this buffer")
- (1- (+ char ?a))))
+ (viper-int-to-char (1- (+ char ?a)))))
(pop-to-buffer (marker-buffer val))
(goto-char val))
((and (consp val) (eq (car val) 'file))
(find-file (cdr val)))
(t
- (error viper-EmptyTextmarker (1- (+ char ?a)))))))
+ (error viper-EmptyTextmarker (viper-int-to-char (1- (+ char ?a))))))))
(defun viper-save-kill-buffer ()
- "Save then kill current buffer. "
+ "Save then kill current buffer."
(interactive)
(if (< viper-expert-level 2)
(save-buffers-kill-emacs)
(require 'reporter)
(set-window-configuration window-config)
- (reporter-submit-bug-report "kifer@cs.sunysb.edu"
+ (reporter-submit-bug-report "kifer@cs.stonybrook.edu"
(viper-version)
varlist
nil 'delete-other-windows
-;; Smoothes out the difference between Emacs' unread-command-events
-;; and XEmacs unread-command-event. Arg is a character, an event, a list of
-;; events or a sequence of keys.
-;;
-;; Due to the way unread-command-events in Emacs (not XEmacs), a non-event
-;; symbol in unread-command-events list may cause Emacs to turn this symbol
-;; into an event. Below, we delete nil from event lists, since nil is the most
-;; common symbol that might appear in this wrong context.
-(defun viper-set-unread-command-events (arg)
- (if viper-emacs-p
- (setq
- unread-command-events
- (let ((new-events
- (cond ((eventp arg) (list arg))
- ((listp arg) arg)
- ((sequencep arg)
- (listify-key-sequence arg))
- (t (error
- "viper-set-unread-command-events: Invalid argument, %S"
- arg)))))
- (if (not (eventp nil))
- (setq new-events (delq nil new-events)))
- (append new-events unread-command-events)))
- ;; XEmacs
- (setq
- unread-command-events
- (append
- (cond ((viper-characterp arg) (list (character-to-event arg)))
- ((eventp arg) (list arg))
- ((stringp arg) (mapcar 'character-to-event arg))
- ((vectorp arg) (append arg nil)) ; turn into list
- ((listp arg) (viper-eventify-list-xemacs arg))
- (t (error
- "viper-set-unread-command-events: Invalid argument, %S" arg)))
- unread-command-events))))
-
-;; list is assumed to be a list of events of characters
-(defun viper-eventify-list-xemacs (lis)
- (mapcar
- (lambda (elt)
- (cond ((viper-characterp elt) (character-to-event elt))
- ((eventp elt) elt)
- (t (error
- "viper-eventify-list-xemacs: can't convert to event, %S"
- elt))))
- lis))
-
-
-
-;;; viper-cmd.el ends here
+
+;; arch-tag: 739a6450-5fda-44d0-88b0-325053d888c2
+;;; viper-cmd.el ends here