comparison lisp/emulation/viper-cmd.el @ 19462:a3240ad2e954

new version

19461:6b67f20dd710

(defvar viper-minibuffer-emacs-face)
(defvar viper-always)
(defvar viper-mode-string)
(defvar viper-custom-file-name)
(defvar iso-accents-mode)
(defvar zmacs-region-stays)
(defvar mark-even-if-inactive)

;; loading happens only in non-interactive compilation
;; in order to spare non-viperized emacs from being viperized

   ((eq viper-current-state 'replace-state)
    ;; delete characters to compensate for inserted chars.
    (let ((replace-boundary (viper-replace-end)))
      (save-excursion
	(goto-char viper-last-posn-in-replace-region)
	(delete-char viper-replace-chars-to-delete)
	(setq viper-replace-chars-to-delete 0
	      viper-replace-chars-deleted 0)
	;; terminate replace mode if reached replace limit
	(if (= viper-last-posn-in-replace-region 
	       (viper-replace-end))
	    (viper-finish-change viper-last-posn-in-replace-region)))
      
      (if (and (<= (viper-replace-start) (point))
	       (<=  (point) replace-boundary))
	  (progn
	    ;; the state may have changed in viper-finish-change above
	    (if (eq viper-current-state 'replace-state)
		(viper-change-cursor-color viper-replace-overlay-cursor-color))
	    (setq viper-last-posn-in-replace-region (point-marker))))
      ))
   
   (t ;; terminate replace mode if changed Viper states.
    (viper-finish-change viper-last-posn-in-replace-region))))


;; changing mode

;; Change state to NEW-STATE---either emacs-state, vi-state, or insert-state.

		     
		(if (> (length viper-last-insertion) 0)
		    (viper-push-onto-ring viper-last-insertion
					  'viper-insertion-ring))
		
		(if viper-ex-style-editing-in-insert
		    (or (bolp) (backward-char 1))))
	       ))
	 
	;; insert or replace
	((memq new-state '(insert-state replace-state))

	) ; outermost cond
  
  ;; Nothing needs to be done to switch to emacs mode! Just set some
  ;; variables, which is already done in viper-change-state-to-emacs!

  (setq viper-current-state new-state)
  (viper-normalize-minor-mode-map-alist)
  (viper-adjust-keys-for new-state)
  (viper-set-mode-vars-for new-state)
  (viper-refresh-mode-line)
  )

	 (setq viper-insert-diehard-minor-mode
	       (not viper-want-emacs-keys-in-insert))
		   
	 (if viper-want-ctl-h-help
	     (progn 
	       (define-key viper-insert-basic-map [(control h)] 'help-command)
	       (define-key viper-replace-map [(control h)] 'help-command))
	   (define-key viper-insert-basic-map 
	     [(control h)] 'viper-del-backward-char-in-insert)
	   (define-key viper-replace-map
	     [(control h)] 'viper-del-backward-char-in-replace)))
		     
	(t ; Vi state
	 (setq viper-vi-diehard-minor-mode (not viper-want-emacs-keys-in-vi))
	 (if viper-want-ctl-h-help
	     (define-key viper-vi-basic-map [(control h)] 'help-command)
	   (define-key viper-vi-basic-map [(control h)] 'viper-backward-char)))
	))
	     
    
;; Normalizes minor-mode-map-alist by putting Viper keymaps first.

		     viper-open-line viper-Open-line
		     viper-replace-state-exit-cmd))
	     (viper-over-whitespace-line))
	(indent-to-left-margin))
    (viper-add-newline-at-eob-if-necessary)
    (if viper-undo-needs-adjustment  (viper-adjust-undo))
    (viper-change-state 'vi-state)

    ;; always turn off iso-accents-mode, or else we won't be able to use the
    ;; keys `,',^ in Vi state, as they will do accents instead of Vi actions.
    (if (and (boundp 'iso-accents-mode) iso-accents-mode)
	(iso-accents-mode -1))

    (viper-restore-cursor-color-after-insert)
    
    ;; Protection against user errors in hooks
    (condition-case conds
	(run-hooks 'viper-vi-state-hook)
      (error
       (viper-message-conditions conds)))))

(defun viper-change-state-to-insert ()
  "Change Viper state to Insert."
  (interactive)
  (viper-change-state 'insert-state)
  (if (and viper-automatic-iso-accents (fboundp 'iso-accents-mode))
      (iso-accents-mode 1)) ; turn iso accents on
  
  (or (stringp viper-saved-cursor-color)
      (string= (viper-get-cursor-color) viper-insert-state-cursor-color)
      (setq viper-saved-cursor-color (viper-get-cursor-color)))
  ;; Commented out, because if viper-change-state-to-insert is executed
  ;; non-interactively then the old cursor color may get lost. Same old Emacs
  ;; bug related to local variables?
;;;(if (stringp viper-saved-cursor-color)
;;;      (viper-change-cursor-color viper-insert-state-cursor-color))
  ;; Protection against user errors in hooks
  (condition-case conds
      (run-hooks 'viper-insert-state-hook)
    (error
     (viper-message-conditions conds))))
     

  
;; Change to replace state. When the end of replacement region is reached,
;; replace state changes to insert state.
(defun viper-change-state-to-replace (&optional non-R-cmd)
  (viper-change-state 'replace-state)
  (if (and viper-automatic-iso-accents (fboundp 'iso-accents-mode))
      (iso-accents-mode 1)) ; turn iso accents on
  ;; Run insert-state-hook
  (condition-case conds
      (run-hooks 'viper-insert-state-hook 'viper-replace-state-hook)
    (error
     (viper-message-conditions conds)))

    
(defun viper-change-state-to-emacs ()
  "Change Viper state to Emacs."
  (interactive)
  (viper-change-state 'emacs-state)
  (if (and viper-automatic-iso-accents (fboundp 'iso-accents-mode))
      (iso-accents-mode 1)) ; turn iso accents on
  
  ;; Protection agains user errors in hooks
  (condition-case conds
      (run-hooks 'viper-emacs-state-hook)
    (error
     (viper-message-conditions conds))))
  

	    (setq viper-last-insertion (nth 4 viper-d-com)
		  viper-d-char (nth 4 viper-d-com)))
        (funcall m-com (cons val com))
        (cond ((and (< save-point (point)) viper-keep-point-on-repeat)
	       (goto-char save-point)) ; go back to before repeat.
	      ((and (< save-point (point)) viper-ex-style-editing-in-insert)
	       (or (bolp) (backward-char 1))))
	(if (and (eolp) (not (bolp)))
	    (backward-char 1))
     ))
  (if viper-undo-needs-adjustment (viper-adjust-undo)) ; take care of undo
  ;; If the prev cmd was rotating the command ring, this means that `.' has
  ;; just executed a command from that ring. So, push it on the ring again.
  ;; If we are just executing previous command , then don't push viper-d-com
  ;; because viper-d-com is not fully constructed in this case (its keys and
  ;; the inserted text may be nil). Besides, in this case, the command

	(progn
	  (push-mark (point-marker) t) 
	  (viper-sit-for-short 300)
	  (goto-char undo-end-posn)
	  (viper-sit-for-short 300)
	  (if (and (> (abs (- undo-beg-posn before-undo-pt)) 1)
		  (> (abs (- undo-end-posn before-undo-pt)) 1))
	      (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)))

;; The following two functions are used to set up undo properly.
;; In VI, unlike Emacs, if you open a line, say, and add a bunch of lines,
;; they are undone all at once.  
(defun viper-adjust-undo ()
  (let ((inhibit-quit t)
	tmp tmp2)
    (setq viper-undo-needs-adjustment nil)
    (if (listp buffer-undo-list)
	(if (setq tmp (memq viper-buffer-undo-list-mark buffer-undo-list))
	    (progn
	      (setq tmp2 (cdr tmp)) ; the part after mark
	      
	      ;; cut tail from buffer-undo-list temporarily by direct
	      ;; manipulation with pointers in buffer-undo-list
	      (setcdr tmp nil)
	      
	      (setq buffer-undo-list (delq nil buffer-undo-list))
	      (setq buffer-undo-list
		    (delq viper-buffer-undo-list-mark buffer-undo-list))
	      ;; restore tail of buffer-undo-list
	      (setq buffer-undo-list (nconc buffer-undo-list tmp2)))
	  (setq buffer-undo-list (delq nil buffer-undo-list))))))
  

(defun viper-set-complex-command-for-undo ()  
  (if (listp buffer-undo-list)
      (if (not viper-undo-needs-adjustment)

	
    (message " `.' runs  %s%s"
	     (concat "`" (viper-array-to-string keys) "'")
	     (viper-abbreviate-string 
	      (if viper-xemacs-p
		  (replace-in-string text "\n" "^J")
		text)
	      max-text-len
	      "  inserting  `" "'" "    ......."))
    ))
    

	(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)
	  (viper-loop val
		    (progn
		      (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-yank-last-insertion)))
	(end-of-line)
	(newline 1)
	(if viper-auto-indent
	    (progn
	      (setq viper-cted t)

	(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)
	  (viper-loop val
		    (progn
		      (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-yank-last-insertion)))
	(beginning-of-line)
	(open-line 1)
	(if viper-auto-indent
	    (progn
	      (setq viper-cted t)

	(com (viper-getcom arg)))
    (viper-set-destructive-command
     (list 'viper-open-line-at-point val ?r nil nil nil))
    (if (equal com ?r)
	(viper-loop val
		  (progn
		    (open-line 1)
		    (viper-yank-last-insertion)))
      (open-line 1)
      (viper-change-state-to-insert))))

(defun viper-substitute (arg)
  "Substitute characters."

;; Prepare for replace
(defun viper-start-replace ()
  (setq viper-began-as-replace t
	viper-sitting-in-replace t
	viper-replace-chars-to-delete 0
	viper-replace-chars-deleted 0)
  (viper-add-hook
   'viper-after-change-functions 'viper-replace-mode-spy-after t)
  (viper-add-hook
   'viper-before-change-functions 'viper-replace-mode-spy-before t)
  ;; this will get added repeatedly, but no harm

   'viper-post-command-hooks 'viper-R-state-post-command-sentinel)
  (if overwrite-mode (overwrite-mode nil))
  )
  

;; checks how many chars were deleted by the last change
(defun viper-replace-mode-spy-before (beg end)
  (setq viper-replace-chars-deleted
	(- end beg
	   (max 0 (- end (viper-replace-end)))
	   (max 0 (- (viper-replace-start) beg))
	   )))

;; Invoked as an after-change-function to set up parameters of the last change
(defun viper-replace-mode-spy-after (beg end length)
  (if (memq viper-intermediate-command '(repeating-insertion-from-ring))
      (progn
	(setq viper-replace-chars-to-delete 0)
	(viper-move-marker-locally 
	 'viper-last-posn-in-replace-region (point)))
    
    (let (beg-col end-col real-end chars-to-delete)
      (setq real-end (min end (viper-replace-end)))
      (save-excursion
	(goto-char beg)
	(setq beg-col (current-column))
	(goto-char real-end)
	(setq end-col (current-column)))
      
      ;; If beg of change is outside the replacement region, then don't
      ;; delete anything in the repl region (set chars-to-delete to 0).
      ;;
      ;; This works fine except that we have to take special care of
      ;; dabbrev-expand.  The problem stems from new-dabbrev.el, which
      ;; sometimes simply shifts the repl region rightwards, without
      ;; deleting an equal amount of characters.
      ;;
      ;; The reason why new-dabbrev.el causes this are this:
      ;; if one dinamically completes a partial word that starts before the
      ;; replacement region (but ends inside) then new-dabbrev.el first
      ;; moves cursor backwards, to the beginning of the word to be
      ;; completed (say, pt A). Then it inserts the 
      ;; completed word and then deletes the old, incomplete part.
      ;; Since the complete word is inserted at position before the repl
      ;; region, the next If-statement would have set chars-to-delete to 0
      ;; unless we check for the current command, which must be
      ;; dabbrev-expand.
      ;;
      ;; In fact, it might be also useful to have overlays for insert
      ;; regions as well, since this will let us capture the situation when
      ;; dabbrev-expand goes back past the insertion point to find the
      ;; beginning of the word to be expanded.
      (if (or (and (<= (viper-replace-start) beg)
		   (<= beg (viper-replace-end)))
	      (and (= length 0) (eq this-command 'dabbrev-expand)))
	  (setq chars-to-delete
		(max (- end-col beg-col) (- real-end beg) 0))
	(setq chars-to-delete 0))
      
      ;; if beg = last change position, it means that we are within the
      ;; same command that does multiple changes. Moreover, it means
      ;; that we have two subsequent changes (insert/delete) that
      ;; complement each other.
      (if (= beg (marker-position viper-last-posn-in-replace-region))
	  (setq viper-replace-chars-to-delete 
		(- (+ chars-to-delete viper-replace-chars-to-delete)
		   viper-replace-chars-deleted)) 
	(setq viper-replace-chars-to-delete chars-to-delete))
      
      (viper-move-marker-locally 
       'viper-last-posn-in-replace-region
       (max (if (> end (viper-replace-end)) (viper-replace-start) end)
	    (or (marker-position viper-last-posn-in-replace-region)
		(viper-replace-start)) 
	    ))
      
      (setq viper-replace-chars-to-delete
	    (max 0
		 (min viper-replace-chars-to-delete
		      (- (viper-replace-end) viper-last-posn-in-replace-region)
		      (- (viper-line-pos 'end)
			 viper-last-posn-in-replace-region)
		      )))
      )))


;; Delete stuff between posn and the end of viper-replace-overlay-marker, if
;; posn is within the overlay.
(defun viper-finish-change (posn)
  (viper-remove-hook
   'viper-after-change-functions 'viper-replace-mode-spy-after)
  (viper-remove-hook
   'viper-before-change-functions 'viper-replace-mode-spy-before)
  (viper-remove-hook

  (viper-remove-hook
   'viper-pre-command-hooks 'viper-replace-state-pre-command-sentinel) 
  (viper-restore-cursor-color-after-replace)
  (setq viper-sitting-in-replace nil) ; just in case we'll need to know it
  (save-excursion
    (if (and 
	 viper-replace-overlay
	 (>= posn (viper-replace-start))
	 (<  posn (viper-replace-end)))
	   (delete-region posn (viper-replace-end)))
    )
  
  (if (eq viper-current-state 'replace-state)
      (viper-downgrade-to-insert))
  ;; replace mode ended => nullify viper-last-posn-in-replace-region
  (viper-move-marker-locally 'viper-last-posn-in-replace-region nil)

  
(defun viper-replace-state-exit-cmd ()
  "Binding for keys that cause Replace state to switch to Vi or to Insert.
These keys are ESC, RET, and LineFeed"
  (interactive)
  (if overwrite-mode  ;; If you are in replace mode invoked via 'R'
      (viper-finish-R-mode)
    (viper-finish-change viper-last-posn-in-replace-region))
  (let (com)
    (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))))

  (if (and (eolp) (bolp)) (error "No character to replace here"))
  (let ((val (viper-p-val arg))
	(com (viper-getcom arg)))
    (viper-replace-char-subr com val)
    (if (and (eolp) (not (bolp))) (forward-char 1))
    (viper-set-destructive-command
     (list 'viper-replace-char val ?r nil viper-d-char nil))
  ))

(defun viper-replace-char-subr (com arg)
  (let ((take-care-of-iso-accents
	 (and (boundp 'iso-accents-mode) viper-automatic-iso-accents))
	char)
    (setq char (if (equal com ?r)
		   viper-d-char
		 (read-char)))
    (if (and  take-care-of-iso-accents (memq char '(?' ?\" ?^ ?~)))
	;; get European characters
	(progn
	  (iso-accents-mode 1)
	  (viper-set-unread-command-events char)
	  (setq char (aref (read-key-sequence nil) 0))
	  (iso-accents-mode -1)))
    (delete-char arg t)
    (setq viper-d-char char)
    (viper-loop (if (> arg 0) arg (- arg)) 
	    (if (eq char ?\C-m) (insert "\n") (insert char)))
    (backward-char arg)))


;; basic cursor movement.  j, k, l, h commands.

(defun viper-forward-char (arg)

	  (if com (viper-execute-com 'viper-backward-char val com)))
      (backward-char val)
      (if com (viper-execute-com 'viper-backward-char val com)))))
      
;; Like forward-char, but doesn't move at end of buffer.
(defun viper-forward-char-carefully (&optional arg)      
  (setq arg (or arg 1))
  (if (>= (point-max) (+ (point) arg))
      (forward-char arg)
    (goto-char (point-max))))
      
;; Like backward-char, but doesn't move at end of buffer.
(defun viper-backward-char-carefully (&optional arg)      
  (setq arg (or arg 1))
  (if (<= (point-min) (- (point) arg))
      (backward-char arg)
    (goto-char (point-min))))

(defun viper-next-line-carefully (arg)
  (condition-case nil
      (next-line arg)
    (error nil)))

	(if (looking-at "\n")
	    (progn
	      (forward-char)
	      (viper-skip-all-separators-forward  'within-line))))
    (viper-skip-all-separators-backward 'within-line)
    (backward-char)
    (if (looking-at "\n")
	(viper-skip-all-separators-backward 'within-line)
      (forward-char))))
      
(defun viper-forward-word-kernel (val)

	  ((not (viper-looking-at-alphasep))
	   (viper-skip-nonalphasep-forward)
	   (viper-skip-separators t)))
    (setq val (1- val))))

;; first search backward for pat. Then skip chars backwards using aux-pat
(defun viper-fwd-skip (pat aux-pat lim)
  (if (and (save-excursion 
	     (re-search-backward pat lim t))
	   (= (point) (match-end 0)))
      (goto-char (match-beginning 0)))
  (skip-chars-backward aux-pat lim)
  (if (= (point) lim)
      (viper-forward-char-carefully))
  )

	  
(defun viper-forward-word (arg)
  "Forward word."
  (interactive "P")

	(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-fwd-skip "\n[ \t]*" " \t" viper-com-point))
		    ;; Yank words including the whitespace, but not newline
		    ((memq com (list ?y (- ?y)))
		     (viper-fwd-skip "\n[ \t]*" "" viper-com-point))
		    ((viper-dotable-command-p com)
		     (viper-fwd-skip "\n[ \t]*" "" viper-com-point)))
	      (viper-execute-com 'viper-forward-word val com)))))
	  

(defun viper-forward-Word (arg)
  "Forward word delimited by white characters."

  (viper-leave-region-active)
  (let ((val (viper-p-val arg))
	(com (viper-getcom arg)))
    (if com (viper-move-marker-locally 'viper-com-point (point)))
    (viper-loop val
	      (progn
		(viper-skip-nonseparators 'forward)
		(viper-skip-separators t)))
    (if com (progn
	      (cond ((memq com (list ?c (- ?c)))
		     (viper-fwd-skip "\n[ \t]*" " \t" viper-com-point))
		    ;; Yank words including the whitespace, but not newline
		    ((memq com (list ?y (- ?y)))
		     (viper-fwd-skip "\n[ \t]*" "" viper-com-point))
		    ((viper-dotable-command-p com)
		     (viper-fwd-skip "\n[ \t]*" "" viper-com-point)))
	      (viper-execute-com 'viper-forward-Word val com)))))


;; this is a bit different from Vi, but Vi's end of word 
;; makes no sense whatsoever

  (viper-leave-region-active)
  (let ((val (viper-p-val arg))
	(com (viper-getcom arg)))
    (if com (viper-move-marker-locally 'viper-com-point (point)))
    (viper-loop val
	      (progn
		(viper-end-of-word-kernel)
		(viper-skip-nonseparators 'forward)
		(backward-char)))
    (if com 
	(progn
	  (forward-char)
	  (viper-execute-com 'viper-end-of-Word val com)))))

(defun viper-backward-word-kernel (val)
  (while (> val 0)
    (backward-char)
    (cond ((viper-looking-at-alpha)
	   (viper-skip-alpha-backward "_"))
	  ((viper-looking-at-separator)
	   (forward-char)
	   (viper-skip-separators nil)
	   (backward-char)
	   (cond ((viper-looking-at-alpha)
		  (viper-skip-alpha-backward "_"))
		 ((not (viper-looking-at-alphasep))
		  (viper-skip-nonalphasep-backward))
		 (t (forward-char))))
	  ((not (viper-looking-at-alphasep))
	   (viper-skip-nonalphasep-backward)))
    (setq val (1- val))))

	  (if (setq i (save-excursion (backward-char) (looking-at "\n")))
	      (backward-char))
	  (viper-move-marker-locally 'viper-com-point (point))
	  (if i (forward-char))))
    (viper-loop val
	      (progn 
		(viper-skip-separators nil)
		(viper-skip-nonseparators 'backward)))
    (if com (viper-execute-com 'viper-backward-Word val com))))



;; line commands

  (interactive "P")
  (viper-leave-region-active)
  (let ((val (viper-p-val arg))
	(com (viper-getcom arg))
	line-len)
    (setq line-len (- (viper-line-pos 'end) (viper-line-pos 'start)))
    (if com (viper-move-marker-locally 'viper-com-point (point)))
    (beginning-of-line)
    (forward-char (1- (min line-len val)))
    (while (> (current-column) (1- val))
      (backward-char 1))

	  (goto-char (point-max)))
	(if (let ((case-fold-search nil))
	      (search-forward (char-to-string char) nil 0 arg))
	    (setq point (point))
	  (error "Command `%s':  `%c' not found" cmd char))))
    (goto-char (+ point (if (> arg 0) (if offset -2 -1) (if offset 1 0))))))

(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

      (copy-region-as-kill beg end)
    (error (copy-region-as-kill beg beg))))
    

(defun viper-delete-char (arg)
  "Delete character."
  (interactive "P")
  (let ((val (viper-p-val arg)))
    (viper-set-destructive-command
     (list 'viper-delete-char val nil nil nil nil))
    (if (> val 1)
	(save-excursion
	  (let ((here (point)))
	    (end-of-line)
	    (if (> val (- (point) here))
		(setq val (- (point) here))))))
    (if (and (eq val 0) (not viper-ex-style-motion)) (setq val 1))
    (if (and viper-ex-style-motion (eolp))
	(if (bolp) (error "") (setq val 0))) ; not bol---simply back 1 ch
    (if viper-use-register
	(progn
	  (cond ((viper-valid-register viper-use-register '((Letter)))
		 (viper-append-to-register
		  (downcase viper-use-register) (point) (- (point) val)))
		((viper-valid-register viper-use-register)
		 (copy-to-register
		  viper-use-register (point) (- (point) val) nil))
		(t (error viper-InvalidRegister viper-use-register)))
	  (setq viper-use-register nil)))
    (if viper-ex-style-motion
	(progn
	  (delete-char val t)
	  (if (and (eolp) (not (bolp))) (backward-char 1)))
      (if (eolp)
          (delete-backward-char val t)
        (delete-char val t)))))

(defun viper-delete-backward-char (arg)
  "Delete previous character. On reaching beginning of line, stop and beep."
  (interactive "P")
  (let ((val (viper-p-val arg)))
    (viper-set-destructive-command
     (list 'viper-delete-backward-char val nil nil nil nil))
    (if (> val 1)
	(save-excursion
	  (let ((here (point)))
	    (beginning-of-line)
	    (if (> val (- here (point)))
		(setq val (- here (point)))))))
    (if viper-use-register
	(progn
	  (cond ((viper-valid-register viper-use-register '(Letter))
		 (viper-append-to-register
		  (downcase viper-use-register) (point) (+ (point) val)))
		((viper-valid-register viper-use-register)
		 (copy-to-register
		  viper-use-register (point) (+ (point) val) nil))
		(t (error viper-InvalidRegister viper-use-register)))
	  (setq viper-use-register nil)))
    (if (bolp) (ding)
      (delete-backward-char val t))))
      
(defun viper-del-backward-char-in-insert ()
  "Delete 1 char backwards while in insert mode."
  (interactive)      
  (if (and viper-ex-style-editing-in-insert (bolp))
      (beep 1)
    (delete-backward-char 1 t)))
      
(defun viper-del-backward-char-in-replace ()
  "Delete one character in replace mode.
If `viper-delete-backwards-in-replace' is t, then DEL key actually deletes
charecters. If it is nil, then the cursor just moves backwards, similarly
to Vi. The variable `viper-ex-style-editing-in-insert', if t, doesn't let the
cursor move past the beginning of line."
  (interactive)
  (cond (viper-delete-backwards-in-replace
	 (cond ((not (bolp))
		(delete-backward-char 1 t))
	       (viper-ex-style-editing-in-insert
		(beep 1))
	       ((bobp)
		(beep 1))
	       (t
		(delete-backward-char 1 t))))
	(viper-ex-style-editing-in-insert
	 (if (bolp)
	     (beep 1)
	   (backward-char 1)))
	(t 
	 (backward-char 1))))

  (interactive "*P")
  (let ((val (viper-P-val arg)))
    (viper-set-destructive-command
     (list 'viper-join-lines val nil nil nil nil))
    (viper-loop (if (null val) 1 (1- val))
	      (progn
		(end-of-line)
		(if (not (eobp))
		    (progn
		      (forward-line 1)
		      (delete-region (point) (1- (point)))

		      ;; fixup-whitespace sometimes does not leave space
		      ;; between objects, so we insert it as in Vi
		      (or (looking-at " ")
			  (insert " ")
			  (backward-char 1))
		      ))))))


;; Replace state

(defun viper-change (beg end)

    ;;    & dont-change-unless = t -- use it; else ask
    (viper-ask-level dont-change-unless))
  
  (setq viper-always          	    		t
	viper-ex-style-motion 	    		t
	viper-ex-style-editing-in-insert	t    
	viper-want-ctl-h-help nil)

  (cond ((eq viper-expert-level 1) ; novice or beginner
	 (global-set-key   ; in emacs-state 
	  viper-toggle-key

	 (if (eq viper-expert-level 4)  ; respect user's ex-style motion
					; and viper-no-multiple-ESC
	     (progn
	       (setq-default
		viper-ex-style-editing-in-insert
		(viper-standard-value 'viper-ex-style-editing-in-insert)
		viper-ex-style-motion
		(viper-standard-value 'viper-ex-style-motion))
	       (setq viper-ex-style-motion 
		     (viper-standard-value 'viper-ex-style-motion)
		     viper-ex-style-editing-in-insert
		     (viper-standard-value 'viper-ex-style-editing-in-insert)
		     viper-re-search
		     (viper-standard-value 'viper-re-search)
		     viper-no-multiple-ESC 
		     (viper-standard-value 'viper-no-multiple-ESC)))))
	
	;; A wizard!!
	;; Ideally, if 5 is selected, a buffer should pop up to let the
	;; user toggle the values of variables.
	(t (setq-default viper-ex-style-editing-in-insert
			 (viper-standard-value 'viper-ex-style-editing-in-insert)
			 viper-ex-style-motion
			 (viper-standard-value 'viper-ex-style-motion))
	   (setq  viper-want-ctl-h-help 
		  (viper-standard-value 'viper-want-ctl-h-help)
		  viper-always
		  (viper-standard-value 'viper-always)
		  viper-no-multiple-ESC 
		  (viper-standard-value 'viper-no-multiple-ESC)
		  viper-ex-style-motion 
		  (viper-standard-value 'viper-ex-style-motion)
		  viper-ex-style-editing-in-insert
		  (viper-standard-value 'viper-ex-style-editing-in-insert)
		  viper-re-search
		  (viper-standard-value 'viper-re-search)
		  viper-electric-mode 
		  (viper-standard-value 'viper-electric-mode)
		  viper-want-emacs-keys-in-vi 

       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
       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-in-insert, and
       viper-re-search variables. Adjust these settings to your taste.
 5 -- WIZARD: Like 4, but user settings are also respected for viper-always,
       viper-electric-mode, viper-want-ctl-h-help, viper-want-emacs-keys-in-vi,
       and viper-want-emacs-keys-in-insert. Adjust these to your taste.
      

		        'viper-emacs-local-user-minor-mode 
		        'viper-emacs-kbd-minor-mode 
		        'viper-emacs-global-user-minor-mode
		        'viper-emacs-state-modifier-minor-mode
		        'viper-automatic-iso-accents
		        'viper-want-emacs-keys-in-insert
		        'viper-want-emacs-keys-in-vi
		        'viper-keep-point-on-undo
		        'viper-no-multiple-ESC
		        'viper-electric-mode
		        'viper-ESC-key
		        'viper-want-ctl-h-help
		        'viper-ex-style-editing-in-insert
		        'viper-delete-backwards-in-replace
		        'viper-vi-style-in-minibuffer
		        'viper-vi-state-hook
		        'viper-insert-state-hook
		        'viper-replace-state-hook

19462:a3240ad2e954

(defvar viper-minibuffer-emacs-face)
(defvar viper-always)
(defvar viper-mode-string)
(defvar viper-custom-file-name)
(defvar iso-accents-mode)
(defvar quail-mode)
(defvar quail-current-str)
(defvar zmacs-region-stays)
(defvar mark-even-if-inactive)

;; loading happens only in non-interactive compilation
;; in order to spare non-viperized emacs from being viperized

   ((eq viper-current-state 'replace-state)
    ;; delete characters to compensate for inserted chars.
    (let ((replace-boundary (viper-replace-end)))
      (save-excursion
	(goto-char viper-last-posn-in-replace-region)
	(viper-trim-replace-chars-to-delete-if-necessary)
	(delete-char viper-replace-chars-to-delete)
	(setq viper-replace-chars-to-delete 0)
	;; terminate replace mode if reached replace limit
	(if (= viper-last-posn-in-replace-region (viper-replace-end))
	    (viper-finish-change)))
      
      (if (viper-pos-within-region
	   (point) (viper-replace-start) replace-boundary)
	  (progn
	    ;; the state may have changed in viper-finish-change above
	    (if (eq viper-current-state 'replace-state)
		(viper-change-cursor-color viper-replace-overlay-cursor-color))
	    (setq viper-last-posn-in-replace-region (point-marker))))
      ))
   ;; terminate replace mode if changed Viper states.
   (t (viper-finish-change))))


;; changing mode

;; Change state to NEW-STATE---either emacs-state, vi-state, or insert-state.

		     
		(if (> (length viper-last-insertion) 0)
		    (viper-push-onto-ring viper-last-insertion
					  'viper-insertion-ring))
		
		(if viper-ex-style-editing
		    (or (bolp) (backward-char 1))))
	       ))
	 
	;; insert or replace
	((memq new-state '(insert-state replace-state))

	) ; outermost cond
  
  ;; Nothing needs to be done to switch to emacs mode! Just set some
  ;; variables, which is already done in viper-change-state-to-emacs!

  ;; ISO accents
  ;; always turn off iso-accents-mode in vi-state, or else we won't be able to
  ;; use the keys `,',^ , as they will do accents instead of Vi actions.
  (cond ((eq new-state 'vi-state) (viper-set-iso-accents-mode nil));accents off
	(viper-automatic-iso-accents (viper-set-iso-accents-mode t));accents on
	(t (viper-set-iso-accents-mode nil)))
  ;; Always turn off quail mode in vi state
  (cond ((eq new-state 'vi-state) (viper-set-input-method nil)) ;intl input off
	(viper-special-input-method (viper-set-input-method t)) ;intl input on
	(t (viper-set-input-method nil)))

  (setq viper-current-state new-state)

  (viper-update-syntax-classes)
  (viper-normalize-minor-mode-map-alist)
  (viper-adjust-keys-for new-state)
  (viper-set-mode-vars-for new-state)
  (viper-refresh-mode-line)
  )

	 (setq viper-insert-diehard-minor-mode
	       (not viper-want-emacs-keys-in-insert))
		   
	 (if viper-want-ctl-h-help
	     (progn 
	       (define-key viper-insert-basic-map [backspace] 'help-command)
	       (define-key viper-replace-map [backspace] 'help-command)
	       (define-key viper-insert-basic-map [(control h)] 'help-command)
	       (define-key viper-replace-map [(control h)] 'help-command))
	   (define-key viper-insert-basic-map 
	     [backspace] 'viper-del-backward-char-in-insert)
	   (define-key viper-replace-map
	     [backspace] 'viper-del-backward-char-in-replace)
	   (define-key viper-insert-basic-map 
	     [(control h)] 'viper-del-backward-char-in-insert)
	   (define-key viper-replace-map
	     [(control h)] 'viper-del-backward-char-in-replace)))
		     
	(t ; Vi state
	 (setq viper-vi-diehard-minor-mode (not viper-want-emacs-keys-in-vi))
	 (if viper-want-ctl-h-help
	     (progn
	       (define-key viper-vi-basic-map [backspace] 'help-command)
	       (define-key viper-vi-basic-map [(control h)] 'help-command))
	   (define-key viper-vi-basic-map [backspace] 'viper-backward-char)
	   (define-key viper-vi-basic-map [(control h)] 'viper-backward-char)))
	))
	     
    
;; Normalizes minor-mode-map-alist by putting Viper keymaps first.

		     viper-open-line viper-Open-line
		     viper-replace-state-exit-cmd))
	     (viper-over-whitespace-line))
	(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)
    
    ;; Protect against user errors in hooks
    (condition-case conds
	(run-hooks 'viper-vi-state-hook)
      (error
       (viper-message-conditions conds)))))

(defun viper-change-state-to-insert ()
  "Change Viper state to Insert."
  (interactive)
  (viper-change-state 'insert-state)
  
  (or (stringp viper-saved-cursor-color)
      (string= (viper-get-cursor-color) viper-insert-state-cursor-color)
      (setq viper-saved-cursor-color (viper-get-cursor-color)))
  ;; Commented out, because if viper-change-state-to-insert is executed
  ;; non-interactively then the old cursor color may get lost. Same old Emacs
  ;; bug related to local variables?
;;;(if (stringp viper-saved-cursor-color)
;;;      (viper-change-cursor-color viper-insert-state-cursor-color))

  ;; Protect against user errors in hooks
  (condition-case conds
      (run-hooks 'viper-insert-state-hook)
    (error
     (viper-message-conditions conds))))
     

  
;; Change to replace state. When the end of replacement region is reached,
;; replace state changes to insert state.
(defun viper-change-state-to-replace (&optional non-R-cmd)
  (viper-change-state 'replace-state)
  ;; Run insert-state-hook
  (condition-case conds
      (run-hooks 'viper-insert-state-hook 'viper-replace-state-hook)
    (error
     (viper-message-conditions conds)))

    
(defun viper-change-state-to-emacs ()
  "Change Viper state to Emacs."
  (interactive)
  (viper-change-state 'emacs-state)
  
  ;; Protect agains user errors in hooks
  (condition-case conds
      (run-hooks 'viper-emacs-state-hook)
    (error
     (viper-message-conditions conds))))
  

	    (setq viper-last-insertion (nth 4 viper-d-com)
		  viper-d-char (nth 4 viper-d-com)))
        (funcall m-com (cons val com))
        (cond ((and (< save-point (point)) viper-keep-point-on-repeat)
	       (goto-char save-point)) ; go back to before repeat.
	      ((and (< save-point (point)) viper-ex-style-editing)
	       (or (bolp) (backward-char 1))))
	(if (and (eolp) (not (bolp)))
	    (backward-char 1))
     ))
  (viper-adjust-undo) ; take care of undo
  ;; If the prev cmd was rotating the command ring, this means that `.' has
  ;; just executed a command from that ring. So, push it on the ring again.
  ;; If we are just executing previous command , then don't push viper-d-com
  ;; because viper-d-com is not fully constructed in this case (its keys and
  ;; the inserted text may be nil). Besides, in this case, the command

	(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))
    (if (and (eolp) (not (bolp))) (backward-char 1))
    (if (not modified) (set-buffer-modified-p t)))

;; The following two functions are used to set up undo properly.
;; In VI, unlike Emacs, if you open a line, say, and add a bunch of lines,
;; they are undone all at once.  
(defun viper-adjust-undo ()
  (if viper-undo-needs-adjustment
      (let ((inhibit-quit t)
	    tmp tmp2)
	(setq viper-undo-needs-adjustment nil)
	(if (listp buffer-undo-list)
	    (if (setq tmp (memq viper-buffer-undo-list-mark buffer-undo-list))
		(progn
		  (setq tmp2 (cdr tmp)) ; the part after mark
		  
		  ;; cut tail from buffer-undo-list temporarily by direct
		  ;; manipulation with pointers in buffer-undo-list
		  (setcdr tmp nil)
		  
		  (setq buffer-undo-list (delq nil buffer-undo-list))
		  (setq buffer-undo-list
			(delq viper-buffer-undo-list-mark buffer-undo-list))
		  ;; restore tail of buffer-undo-list
		  (setq buffer-undo-list (nconc buffer-undo-list tmp2)))
	      (setq buffer-undo-list (delq nil buffer-undo-list)))))
    ))
  

(defun viper-set-complex-command-for-undo ()  
  (if (listp buffer-undo-list)
      (if (not viper-undo-needs-adjustment)

	
    (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)
	      max-text-len
	      "  inserting  `" "'" "    ......."))
    ))
    

	(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)
	  (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-yank-last-insertion))
	(end-of-line)
	(newline 1)
	(if viper-auto-indent
	    (progn
	      (setq viper-cted t)

	(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)
	  (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-yank-last-insertion))
	(beginning-of-line)
	(open-line 1)
	(if viper-auto-indent
	    (progn
	      (setq viper-cted t)

	(com (viper-getcom arg)))
    (viper-set-destructive-command
     (list 'viper-open-line-at-point val ?r nil nil nil))
    (if (equal com ?r)
	(viper-loop val
		    (open-line 1)
		    (viper-yank-last-insertion))
      (open-line 1)
      (viper-change-state-to-insert))))

(defun viper-substitute (arg)
  "Substitute characters."

;; Prepare for replace
(defun viper-start-replace ()
  (setq viper-began-as-replace t
	viper-sitting-in-replace t
	viper-replace-chars-to-delete 0)
  (viper-add-hook
   'viper-after-change-functions 'viper-replace-mode-spy-after t)
  (viper-add-hook
   'viper-before-change-functions 'viper-replace-mode-spy-before t)
  ;; this will get added repeatedly, but no harm

   'viper-post-command-hooks 'viper-R-state-post-command-sentinel)
  (if overwrite-mode (overwrite-mode nil))
  )
  

(defun viper-replace-mode-spy-before (beg end)
  (setq viper-replace-region-chars-deleted (viper-chars-in-region beg end))
  )

;; Invoked as an after-change-function to calculate how many chars have to be
;; deleted. This function may be called several times within a single command,
;; if this command performs several separate buffer changes. Therefore, if adds
;; up the number of chars inserted and subtracts the number of chars deleted.
(defun viper-replace-mode-spy-after (beg end length)
  (if (memq viper-intermediate-command 
	    '(dabbrev-expand repeating-insertion-from-ring))
      ;; Take special care of text insertion from insertion ring inside
      ;; replacement overlays.
      (progn
	(setq viper-replace-chars-to-delete 0)
	(viper-move-marker-locally 
	 'viper-last-posn-in-replace-region (point)))
    
    (let* ((real-end (min end (viper-replace-end)))
	   (column-shift (- (save-excursion (goto-char real-end)
					    (current-column))
			    (save-excursion (goto-char beg)
					    (current-column))))
	   (chars-deleted 0))

      (if (> length 0)
	  (setq chars-deleted viper-replace-region-chars-deleted))
      (setq viper-replace-region-chars-deleted 0)
      (setq viper-replace-chars-to-delete
	    (+ viper-replace-chars-to-delete
	       (- 
		;; if column shift is bigger, due to a TAB insertion, take
		;; column-shift instead of the number of inserted chars
		(max (viper-chars-in-region beg real-end)
		     ;; This test accounts for Chinese/Japanese/...  chars,
		     ;; which occupy 2 columns instead of one. If we use
		     ;; column-shift here, we may delete two chars instead of
		     ;; one when the user types one Chinese character. Deleting
		     ;; two would be OK, if they were European chars, but it is
		     ;; not OK if they are Chinese chars. Since it is hard to
		     ;; figure out which characters are being deleted in any
		     ;; given region, we decided to treat Eastern and European
		     ;; characters equally, even though Eastern chars may
		     ;; occupy more columns.
		     (if (memq this-command '(self-insert-command
					      quoted-insert viper-insert-tab))
			 column-shift
		       0))
		;; the number of deleted chars
		chars-deleted)))

      (viper-move-marker-locally 
       'viper-last-posn-in-replace-region
       (max (if (> end (viper-replace-end)) (viper-replace-end) end)
	    (or (marker-position viper-last-posn-in-replace-region)
		(viper-replace-start)) 
	    ))
      
      )))

;; Make sure we don't delete more than needed.
;; This is executed at viper-last-posn-in-replace-region
(defsubst viper-trim-replace-chars-to-delete-if-necessary ()
  (setq viper-replace-chars-to-delete
	(max 0
	     (min viper-replace-chars-to-delete
		  ;; Don't delete more than to the end of repl overlay
		  (viper-chars-in-region
		   (viper-replace-end) viper-last-posn-in-replace-region)
		  ;; point is viper-last-posn-in-replace-region now
		  ;; So, this limits deletion to the end of line
		  (viper-chars-in-region (point) (viper-line-pos 'end))
		  ))))


;; Delete stuff between viper-last-posn-in-replace-region and the end of
;; viper-replace-overlay-marker, if viper-last-posn-in-replace-region is within
;; the overlay and current point is before the end of the overlay.
;; Don't delete anything if current point is past the end of the overlay.
(defun viper-finish-change ()
  (viper-remove-hook
   'viper-after-change-functions 'viper-replace-mode-spy-after)
  (viper-remove-hook
   'viper-before-change-functions 'viper-replace-mode-spy-before)
  (viper-remove-hook

  (viper-remove-hook
   'viper-pre-command-hooks 'viper-replace-state-pre-command-sentinel) 
  (viper-restore-cursor-color-after-replace)
  (setq viper-sitting-in-replace nil) ; just in case we'll need to know it
  (save-excursion
    (if (and viper-replace-overlay
	     (viper-pos-within-region viper-last-posn-in-replace-region
				      (viper-replace-start)
				      (viper-replace-end)) 
	     (< (point) (viper-replace-end)))
	(delete-region
	 viper-last-posn-in-replace-region (viper-replace-end))))
  
  (if (eq viper-current-state 'replace-state)
      (viper-downgrade-to-insert))
  ;; replace mode ended => nullify viper-last-posn-in-replace-region
  (viper-move-marker-locally 'viper-last-posn-in-replace-region nil)

  
(defun viper-replace-state-exit-cmd ()
  "Binding for keys that cause Replace state to switch to Vi or to Insert.
These keys are ESC, RET, and LineFeed"
  (interactive)
  (if overwrite-mode   ; if in replace mode invoked via 'R'
      (viper-finish-R-mode)
    (viper-finish-change))
  (let (com)
    (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))))

  (if (and (eolp) (bolp)) (error "No character to replace here"))
  (let ((val (viper-p-val arg))
	(com (viper-getcom arg)))
    (viper-replace-char-subr com val)
    (if (and (eolp) (not (bolp))) (forward-char 1))
    (setq viper-this-command-keys
	  (format "%sr" (if (integerp arg) arg "")))
    (viper-set-destructive-command
     (list 'viper-replace-char val ?r nil viper-d-char nil))
  ))

(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))))


;; basic cursor movement.  j, k, l, h commands.

(defun viper-forward-char (arg)

	  (if com (viper-execute-com 'viper-backward-char val com)))
      (backward-char val)
      (if com (viper-execute-com 'viper-backward-char val com)))))
      
;; Like forward-char, but doesn't move at end of buffer.
;; Returns distance traveled 
;; (positive or 0, if arg positive; negative if arg negative).
(defun viper-forward-char-carefully (&optional arg)      
  (setq arg (or arg 1))
  (let ((pt (point)))
    (condition-case nil
	(forward-char arg)
      (error))
    (if (< (point) pt) ; arg was negative
	(- (viper-chars-in-region pt (point)))
      (viper-chars-in-region pt (point)))))
      
;; Like backward-char, but doesn't move at beg of buffer.
;; Returns distance traveled
;; (negative or 0, if arg positive; positive if arg negative).
(defun viper-backward-char-carefully (&optional arg)      
  (setq arg (or arg 1))
  (let ((pt (point)))
    (condition-case nil
	(backward-char arg)
      (error))
    (if (> (point) pt) ; arg was negative
	(viper-chars-in-region pt (point))
      (- (viper-chars-in-region pt (point))))))

(defun viper-next-line-carefully (arg)
  (condition-case nil
      (next-line arg)
    (error nil)))

	(if (looking-at "\n")
	    (progn
	      (forward-char)
	      (viper-skip-all-separators-forward  'within-line))))
    (viper-skip-all-separators-backward 'within-line)
    (viper-backward-char-carefully)
    (if (looking-at "\n")
	(viper-skip-all-separators-backward 'within-line)
      (forward-char))))
      
(defun viper-forward-word-kernel (val)

	  ((not (viper-looking-at-alphasep))
	   (viper-skip-nonalphasep-forward)
	   (viper-skip-separators t)))
    (setq val (1- val))))

;; first skip non-newline separators backward, then skip \n. Then, if TWICE is
;; non-nil, skip non-\n back again, but don't overshoot the limit LIM.
(defun viper-separator-skipback-special (twice lim)
  (let ((prev-char (viper-char-at-pos 'backward))
	(saved-point (point)))
    ;; skip non-newline separators backward
    (while (and (not (memq 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-backward-char-carefully)
      (setq prev-char (viper-char-at-pos 'backward)))

    (if (and (< lim (point)) (eq prev-char ?\n))
	(backward-char)
      ;; If we skipped to the next word and the prefix of this line doesn't
      ;; consist of separators preceded by a newline, then don't skip backwards
      ;; at all.
      (goto-char saved-point))
    (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)))
		    (< lim (point))
		    ;; must be non-newline separator
		    (if (eq viper-syntax-preference 'strict-vi)
			(memq prev-char '(?\  ?\t))
		      (memq (char-syntax prev-char) '(?\  ?-))))
	  (viper-backward-char-carefully)
	  (setq prev-char (viper-char-at-pos 'backward))))

    (if (= (point) lim)
	(viper-forward-char-carefully))
    ))

	  
(defun viper-forward-word (arg)
  "Forward word."
  (interactive "P")

	(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)))))
	  

(defun viper-forward-Word (arg)
  "Forward word delimited by white characters."

  (viper-leave-region-active)
  (let ((val (viper-p-val arg))
	(com (viper-getcom arg)))
    (if com (viper-move-marker-locally 'viper-com-point (point)))
    (viper-loop val
		(viper-skip-nonseparators 'forward)
		(viper-skip-separators t))
    (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)))))


;; this is a bit different from Vi, but Vi's end of word 
;; makes no sense whatsoever

  (viper-leave-region-active)
  (let ((val (viper-p-val arg))
	(com (viper-getcom arg)))
    (if com (viper-move-marker-locally 'viper-com-point (point)))
    (viper-loop val
		(viper-end-of-word-kernel)
		(viper-skip-nonseparators 'forward)
		(backward-char))
    (if com 
	(progn
	  (forward-char)
	  (viper-execute-com 'viper-end-of-Word val com)))))

(defun viper-backward-word-kernel (val)
  (while (> val 0)
    (viper-backward-char-carefully)
    (cond ((viper-looking-at-alpha)
	   (viper-skip-alpha-backward "_"))
	  ((viper-looking-at-separator)
	   (forward-char)
	   (viper-skip-separators nil)
	   (viper-backward-char-carefully)
	   (cond ((viper-looking-at-alpha)
		  (viper-skip-alpha-backward "_"))
		 ((not (viper-looking-at-alphasep))
		  (viper-skip-nonalphasep-backward))
		 ((bobp)) ; could still be at separator, but at beg of buffer
		 (t (forward-char))))
	  ((not (viper-looking-at-alphasep))
	   (viper-skip-nonalphasep-backward)))
    (setq val (1- val))))

	  (if (setq i (save-excursion (backward-char) (looking-at "\n")))
	      (backward-char))
	  (viper-move-marker-locally 'viper-com-point (point))
	  (if i (forward-char))))
    (viper-loop val
		(viper-skip-separators nil) ; nil means backward here
		(viper-skip-nonseparators 'backward))
    (if com (viper-execute-com 'viper-backward-Word val com))))



;; line commands

  (interactive "P")
  (viper-leave-region-active)
  (let ((val (viper-p-val arg))
	(com (viper-getcom arg))
	line-len)
    (setq line-len
	  (viper-chars-in-region
	   (viper-line-pos 'start) (viper-line-pos 'end)))
    (if com (viper-move-marker-locally 'viper-com-point (point)))
    (beginning-of-line)
    (forward-char (1- (min line-len val)))
    (while (> (current-column) (1- val))
      (backward-char 1))

	  (goto-char (point-max)))
	(if (let ((case-fold-search nil))
	      (search-forward (char-to-string char) nil 0 arg))
	    (setq point (point))
	  (error "Command `%s':  `%c' not found" cmd char))))
    (goto-char point)
    (if (> arg 0)
	(backward-char (if offset 2 1))
      (forward-char (if offset 1 0)))))

(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

      (copy-region-as-kill beg end)
    (error (copy-region-as-kill beg beg))))
    

(defun viper-delete-char (arg)
  "Delete next character."
  (interactive "P")
  (let ((val (viper-p-val arg))
	end-del-pos)
    (viper-set-destructive-command
     (list 'viper-delete-char val nil nil nil nil))
    (if (and viper-ex-style-editing
	     (> val (viper-chars-in-region (point) (viper-line-pos 'end))))
	(setq val (viper-chars-in-region (point) (viper-line-pos 'end))))
    (if (and viper-ex-style-motion (eolp))
	(if (bolp) (error "") (setq val 0))) ; not bol---simply back 1 ch
    (save-excursion
      (viper-forward-char-carefully val)
      (setq end-del-pos (point)))
    (if viper-use-register
	(progn
	  (cond ((viper-valid-register viper-use-register '((Letter)))
		 (viper-append-to-register
		  (downcase viper-use-register) (point) end-del-pos))
		((viper-valid-register viper-use-register)
		 (copy-to-register
		  viper-use-register (point) end-del-pos nil))
		(t (error viper-InvalidRegister viper-use-register)))
	  (setq viper-use-register nil)))

    (delete-char val t)
    (if viper-ex-style-motion
	(if (and (eolp) (not (bolp))) (backward-char 1)))
    ))

(defun viper-delete-backward-char (arg)
  "Delete previous character. On reaching beginning of line, stop and beep."
  (interactive "P")
  (let ((val (viper-p-val arg))
	end-del-pos)
    (viper-set-destructive-command
     (list 'viper-delete-backward-char val nil nil nil nil))
    (if (and 
	 viper-ex-style-editing
	 (> val (viper-chars-in-region (viper-line-pos 'start) (point))))
	(setq val (viper-chars-in-region (viper-line-pos 'start) (point))))
    (save-excursion
      (viper-backward-char-carefully val)
      (setq end-del-pos (point)))
    (if viper-use-register
	(progn
	  (cond ((viper-valid-register viper-use-register '(Letter))
		 (viper-append-to-register
		  (downcase viper-use-register) end-del-pos (point)))
		((viper-valid-register viper-use-register)
		 (copy-to-register
		  viper-use-register end-del-pos (point) nil))
		(t (error viper-InvalidRegister viper-use-register)))
	  (setq viper-use-register nil)))
    (if (and (bolp) viper-ex-style-editing)
	(ding))
    (delete-backward-char val t)))
      
(defun viper-del-backward-char-in-insert ()
  "Delete 1 char backwards while in insert mode."
  (interactive)      
  (if (and viper-ex-style-editing (bolp))
      (beep 1)
    (delete-backward-char 1 t)))
      
(defun viper-del-backward-char-in-replace ()
  "Delete one character in replace mode.
If `viper-delete-backwards-in-replace' is t, then DEL key actually deletes
charecters. If it is nil, then the cursor just moves backwards, similarly
to Vi. The variable `viper-ex-style-editing', if t, doesn't let the
cursor move past the beginning of line."
  (interactive)
  (cond (viper-delete-backwards-in-replace
	 (cond ((not (bolp))
		(delete-backward-char 1 t))
	       (viper-ex-style-editing
		(beep 1))
	       ((bobp)
		(beep 1))
	       (t
		(delete-backward-char 1 t))))
	(viper-ex-style-editing
	 (if (bolp)
	     (beep 1)
	   (backward-char 1)))
	(t 
	 (backward-char 1))))

  (interactive "*P")
  (let ((val (viper-P-val arg)))
    (viper-set-destructive-command
     (list 'viper-join-lines val nil nil nil nil))
    (viper-loop (if (null val) 1 (1- val))
		(end-of-line)
		(if (not (eobp))
		    (progn
		      (forward-line 1)
		      (delete-region (point) (1- (point)))

		      ;; fixup-whitespace sometimes does not leave space
		      ;; between objects, so we insert it as in Vi
		      (or (looking-at " ")
			  (insert " ")
			  (backward-char 1))
		      )))))


;; Replace state

(defun viper-change (beg end)

    ;;    & dont-change-unless = t -- use it; else ask
    (viper-ask-level dont-change-unless))
  
  (setq viper-always          	    		t
	viper-ex-style-motion 	    		t
	viper-ex-style-editing			t    
	viper-want-ctl-h-help nil)

  (cond ((eq viper-expert-level 1) ; novice or beginner
	 (global-set-key   ; in emacs-state 
	  viper-toggle-key

	 (if (eq viper-expert-level 4)  ; respect user's ex-style motion
					; and viper-no-multiple-ESC
	     (progn
	       (setq-default
		viper-ex-style-editing
		(viper-standard-value 'viper-ex-style-editing)
		viper-ex-style-motion
		(viper-standard-value 'viper-ex-style-motion))
	       (setq viper-ex-style-motion 
		     (viper-standard-value 'viper-ex-style-motion)
		     viper-ex-style-editing
		     (viper-standard-value 'viper-ex-style-editing)
		     viper-re-search
		     (viper-standard-value 'viper-re-search)
		     viper-no-multiple-ESC 
		     (viper-standard-value 'viper-no-multiple-ESC)))))
	
	;; A wizard!!
	;; Ideally, if 5 is selected, a buffer should pop up to let the
	;; user toggle the values of variables.
	(t (setq-default viper-ex-style-editing
			 (viper-standard-value 'viper-ex-style-editing)
			 viper-ex-style-motion
			 (viper-standard-value 'viper-ex-style-motion))
	   (setq  viper-want-ctl-h-help 
		  (viper-standard-value 'viper-want-ctl-h-help)
		  viper-always
		  (viper-standard-value 'viper-always)
		  viper-no-multiple-ESC 
		  (viper-standard-value 'viper-no-multiple-ESC)
		  viper-ex-style-motion 
		  (viper-standard-value 'viper-ex-style-motion)
		  viper-ex-style-editing
		  (viper-standard-value 'viper-ex-style-editing)
		  viper-re-search
		  (viper-standard-value 'viper-re-search)
		  viper-electric-mode 
		  (viper-standard-value 'viper-electric-mode)
		  viper-want-emacs-keys-in-vi 

       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
       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
       viper-re-search variables. Adjust these settings to your taste.
 5 -- WIZARD: Like 4, but user settings are also respected for viper-always,
       viper-electric-mode, viper-want-ctl-h-help, viper-want-emacs-keys-in-vi,
       and viper-want-emacs-keys-in-insert. Adjust these to your taste.
      

		        'viper-emacs-local-user-minor-mode 
		        'viper-emacs-kbd-minor-mode 
		        'viper-emacs-global-user-minor-mode
		        'viper-emacs-state-modifier-minor-mode
		        'viper-automatic-iso-accents
			'viper-special-input-method
		        'viper-want-emacs-keys-in-insert
		        'viper-want-emacs-keys-in-vi
		        'viper-keep-point-on-undo
		        'viper-no-multiple-ESC
		        'viper-electric-mode
		        'viper-ESC-key
		        'viper-want-ctl-h-help
		        'viper-ex-style-editing
		        'viper-delete-backwards-in-replace
		        'viper-vi-style-in-minibuffer
		        'viper-vi-state-hook
		        'viper-insert-state-hook
		        'viper-replace-state-hook