(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)
(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
- viper-replace-chars-deleted 0)
+ (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 viper-last-posn-in-replace-region)))
+ (if (= viper-last-posn-in-replace-region (viper-replace-end))
+ (viper-finish-change)))
- (if (and (<= (viper-replace-start) (point))
- (<= (point) replace-boundary))
+ (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))))
))
-
- (t ;; terminate replace mode if changed Viper states.
- (viper-finish-change viper-last-posn-in-replace-region))))
+ ;; terminate replace mode if changed Viper states.
+ (t (viper-finish-change))))
;; changing mode
(viper-push-onto-ring viper-last-insertion
'viper-insertion-ring))
- (if viper-ex-style-editing-in-insert
+ (if viper-ex-style-editing
(or (bolp) (backward-char 1))))
))
;; 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)
(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
(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)
+ (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)))
))
(viper-over-whitespace-line))
(indent-to-left-margin))
(viper-add-newline-at-eob-if-necessary)
- (if viper-undo-needs-adjustment (viper-adjust-undo))
+ (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
+ ;; Protect against user errors in hooks
(condition-case conds
(run-hooks 'viper-vi-state-hook)
(error
"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)
;; 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
+
+ ;; Protect against user errors in hooks
(condition-case conds
(run-hooks 'viper-insert-state-hook)
(error
;; 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)
"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
+ ;; Protect agains user errors in hooks
(condition-case conds
(run-hooks 'viper-emacs-state-hook)
(error
(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)
+ ((and (< save-point (point)) viper-ex-style-editing)
(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
+ (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
(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))
+ (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))
;; 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))))))
+ (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 ()
(concat "`" (viper-array-to-string keys) "'")
(viper-abbreviate-string
(if viper-xemacs-p
- (replace-in-string text "\n" "^J")
+ (replace-in-string
+ (cond ((characterp text) (char-to-string text))
+ ((stringp text) text)
+ (t ""))
+ "\n" "^J")
text)
max-text-len
" inserting `" "'" " ......."))
(let ((col (current-indentation)))
(if (equal com ?r)
(viper-loop val
- (progn
(end-of-line)
(newline 1)
(if viper-auto-indent
(indent-according-to-mode)
(indent-to col))
))
- (viper-yank-last-insertion)))
+ (viper-yank-last-insertion))
(end-of-line)
(newline 1)
(if viper-auto-indent
(let ((col (current-indentation)))
(if (equal com ?r)
(viper-loop val
- (progn
(beginning-of-line)
(open-line 1)
(if viper-auto-indent
(indent-according-to-mode)
(indent-to col))
))
- (viper-yank-last-insertion)))
+ (viper-yank-last-insertion))
(beginning-of-line)
(open-line 1)
(if viper-auto-indent
(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)))
+ (viper-yank-last-insertion))
(open-line 1)
(viper-change-state-to-insert))))
(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-replace-chars-to-delete 0)
(viper-add-hook
'viper-after-change-functions 'viper-replace-mode-spy-after t)
(viper-add-hook
)
-;; 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))
- )))
+ (setq viper-replace-region-chars-deleted (viper-chars-in-region beg end))
+ )
-;; Invoked as an after-change-function to set up parameters of the last change
+;; 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 '(repeating-insertion-from-ring))
+ (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 (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))
-
+ (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-start) end)
+ (max (if (> end (viper-replace-end)) (viper-replace-end) 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)
+;; 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-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 (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))
"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'
+ (if overwrite-mode ; if in replace mode invoked via 'R'
(viper-finish-R-mode)
- (viper-finish-change viper-last-posn-in-replace-region))
+ (viper-finish-change))
(let (com)
(if (eq this-command 'viper-intercept-ESC-key)
(setq com 'viper-exit-insert-state)
(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 ((take-care-of-iso-accents
- (and (boundp 'iso-accents-mode) viper-automatic-iso-accents))
- char)
+ (let (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)))
+ (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))))
\f
;; basic cursor movement. j, k, l, h commands.
(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))
- (if (>= (point-max) (+ (point) arg))
- (forward-char arg)
- (goto-char (point-max))))
+ (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 end of buffer.
+;; 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))
- (if (<= (point-min) (- (point) arg))
- (backward-char arg)
- (goto-char (point-min))))
+ (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
(forward-char)
(viper-skip-all-separators-forward 'within-line))))
(viper-skip-all-separators-backward 'within-line)
- (backward-char)
+ (viper-backward-char-carefully)
(if (looking-at "\n")
(viper-skip-all-separators-backward 'within-line)
(forward-char))))
(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))
- )
+;; 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)
(viper-forward-word-kernel val)
(if com (progn
(cond ((memq com (list ?c (- ?c)))
- (viper-fwd-skip "\n[ \t]*" " \t" viper-com-point))
+ (viper-separator-skipback-special 'twice 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-separator-skipback-special nil viper-com-point))
((viper-dotable-command-p com)
- (viper-fwd-skip "\n[ \t]*" "" viper-com-point)))
+ (viper-separator-skipback-special nil viper-com-point)))
(viper-execute-com 'viper-forward-word val com)))))
(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)))
+ (viper-skip-separators t))
(if com (progn
(cond ((memq com (list ?c (- ?c)))
- (viper-fwd-skip "\n[ \t]*" " \t" viper-com-point))
+ (viper-separator-skipback-special 'twice 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-separator-skipback-special nil viper-com-point))
((viper-dotable-command-p com)
- (viper-fwd-skip "\n[ \t]*" "" viper-com-point)))
+ (viper-separator-skipback-special nil viper-com-point)))
(viper-execute-com 'viper-forward-Word val com)))))
(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)))
+ (backward-char))
(if com
(progn
(forward-char)
(defun viper-backward-word-kernel (val)
(while (> val 0)
- (backward-char)
+ (viper-backward-char-carefully)
(cond ((viper-looking-at-alpha)
(viper-skip-alpha-backward "_"))
((viper-looking-at-separator)
(forward-char)
(viper-skip-separators nil)
- (backward-char)
+ (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)))
(viper-move-marker-locally 'viper-com-point (point))
(if i (forward-char))))
(viper-loop val
- (progn
- (viper-skip-separators nil)
- (viper-skip-nonseparators 'backward)))
+ (viper-skip-separators nil) ; nil means backward here
+ (viper-skip-nonseparators 'backward))
(if com (viper-execute-com 'viper-backward-Word val com))))
(let ((val (viper-p-val arg))
(com (viper-getcom arg))
line-len)
- (setq line-len (- (viper-line-pos 'end) (viper-line-pos 'start)))
+ (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)))
(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))))))
+ (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.
(defun viper-delete-char (arg)
- "Delete character."
+ "Delete next character."
(interactive "P")
- (let ((val (viper-p-val arg)))
+ (let ((val (viper-p-val arg))
+ end-del-pos)
(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-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) (- (point) val)))
+ (downcase viper-use-register) (point) end-del-pos))
((viper-valid-register viper-use-register)
(copy-to-register
- viper-use-register (point) (- (point) val) nil))
+ 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
- (progn
- (delete-char val t)
- (if (and (eolp) (not (bolp))) (backward-char 1)))
- (if (eolp)
- (delete-backward-char val t)
- (delete-char val t)))))
+ (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)))
+ (let ((val (viper-p-val arg))
+ end-del-pos)
(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 (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) (point) (+ (point) val)))
+ (downcase viper-use-register) end-del-pos (point)))
((viper-valid-register viper-use-register)
(copy-to-register
- viper-use-register (point) (+ (point) val) nil))
+ viper-use-register end-del-pos (point) nil))
(t (error viper-InvalidRegister viper-use-register)))
(setq viper-use-register nil)))
- (if (bolp) (ding)
- (delete-backward-char val t))))
+ (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-in-insert (bolp))
+ (if (and viper-ex-style-editing (bolp))
(beep 1)
(delete-backward-char 1 t)))
"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
+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-in-insert
+ (viper-ex-style-editing
(beep 1))
((bobp)
(beep 1))
(t
(delete-backward-char 1 t))))
- (viper-ex-style-editing-in-insert
+ (viper-ex-style-editing
(if (bolp)
(beep 1)
(backward-char 1)))
(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
(or (looking-at " ")
(insert " ")
(backward-char 1))
- ))))))
+ )))))
\f
;; Replace state
(setq viper-always t
viper-ex-style-motion t
- viper-ex-style-editing-in-insert t
+ viper-ex-style-editing t
viper-want-ctl-h-help nil)
(cond ((eq viper-expert-level 1) ; novice or beginner
; 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-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-in-insert
- (viper-standard-value 'viper-ex-style-editing-in-insert)
+ viper-ex-style-editing
+ (viper-standard-value 'viper-ex-style-editing)
viper-re-search
(viper-standard-value 'viper-re-search)
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)
+ (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-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-ex-style-editing
+ (viper-standard-value 'viper-ex-style-editing)
viper-re-search
(viper-standard-value 'viper-re-search)
viper-electric-mode
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-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,
'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-electric-mode
'viper-ESC-key
'viper-want-ctl-h-help
- 'viper-ex-style-editing-in-insert
+ 'viper-ex-style-editing
'viper-delete-backwards-in-replace
'viper-vi-style-in-minibuffer
'viper-vi-state-hook
;; compiler pacifier
(defvar mark-even-if-inactive)
+(defvar quail-mode)
+(defvar iso-accents-mode)
+(defvar viper-current-state)
(defvar viper-version)
(defvar viper-expert-level)
;; end pacifier
(make-variable-buffer-local '(, var))
)))
-(defmacro viper-loop (count body)
- "(viper-loop COUNT BODY) Execute BODY COUNT times."
- (list 'let (list (list 'count count))
- (list 'while '(> count 0)
- body
- '(setq count (1- count))
- )))
+;; (viper-loop COUNT BODY) Execute BODY COUNT times.
+(defmacro viper-loop (count &rest body)
+ (` (let ((count (, count)))
+ (while (> count 0)
+ (progn
+ (,@ body)
+ (setq count (1- count))
+ ))
+ )))
(defmacro viper-buffer-live-p (buf)
(` (and (, buf) (get-buffer (, buf)) (buffer-name (get-buffer (, buf))))))
;; last elt of a sequence
(defsubst viper-seq-last-elt (seq)
(elt seq (1- (length seq))))
+
+(defsubst viper-string-to-list (string)
+ (append (vconcat string) nil))
+
+(defsubst viper-charlist-to-string (list)
+ (mapconcat 'char-to-string list ""))
+
+;; like char-after/before, but saves typing
+(defun viper-char-at-pos (direction &optional offset)
+ (or (integerp offset) (setq offset 0))
+ (if (eq direction 'forward)
+ (char-after (+ (point) offset))
+ (char-before (- (point) offset))))
\f
(defvar viper-minibuffer-overlay-priority 300)
(defconst viper-max-expert-level 5)
-;;; ISO characters
-
+;;; ISO characters and MULE
+
+;; If non-nil, ISO accents will be turned on in insert/replace emacs states and
+;; turned off in vi-state. For some users, this behavior may be too
+;; primitive. In this case, use insert/emacs/vi state hooks.
(viper-deflocalvar viper-automatic-iso-accents nil "")
-(defcustom viper-automatic-iso-accents nil
- "*If non-nil, ISO accents will be turned on in insert/replace emacs states and turned off in vi-state.
-For some users, this behavior may be too primitive. In this case, use
-insert/emacs/vi state hooks."
- :type 'boolean
- :group 'viper)
+;; Set iso-accents-mode to ARG. Check if it is bound first
+(defsubst viper-set-iso-accents-mode (arg)
+ (if (boundp 'iso-accents-mode)
+ (setq iso-accents-mode arg)))
+
+;; Internal flag used to control when viper mule hooks are run.
+;; Don't change this!
+(defvar viper-mule-hook-flag t)
+;; If non-nil, the default intl. input method is turned on.
+(viper-deflocalvar viper-special-input-method nil "")
+;; viper hook to run on input-method activation
+(defun viper-activate-input-method-action ()
+ (if (null viper-mule-hook-flag)
+ ()
+ (setq viper-special-input-method t)
+ ;; turn off special input methods in vi-state
+ (if (eq viper-current-state 'vi-state)
+ (viper-set-input-method nil))
+ (if (memq viper-current-state '(vi-state insert-state replace-state))
+ (message "Viper special input method%s: on"
+ (if (or current-input-method default-input-method)
+ (format " %S"
+ (or current-input-method default-input-method))
+ "")))
+ ))
+;; viper hook to run on input-method deactivation
+(defun viper-inactivate-input-method-action ()
+ (if (null viper-mule-hook-flag)
+ ()
+ (setq viper-special-input-method nil)
+ (if (memq viper-current-state '(vi-state insert-state replace-state))
+ (message "Viper special input method%s: off"
+ (if (or current-input-method default-input-method)
+ (format " %S"
+ (or current-input-method default-input-method))
+ "")))))
+
+(defun viper-inactivate-input-method ()
+ (cond ((and viper-emacs-p (fboundp 'inactivate-input-method))
+ (inactivate-input-method))
+ ((and viper-xemacs-p (boundp 'current-input-method))
+ ;; XEmacs had broken quil-mode for some time, so we are working around
+ ;; it here
+ (setq quail-mode nil)
+ (if (featurep 'quail)
+ (quail-delete-overlays))
+ (setq describe-current-input-method-function nil)
+ (setq current-input-method nil)
+ (run-hooks 'input-method-inactivate-hook)
+ (force-mode-line-update))
+ ))
+(defun viper-activate-input-method ()
+ (cond ((and viper-emacs-p (fboundp 'activate-input-method))
+ (activate-input-method default-input-method))
+ ((and viper-xemacs-p (fboundp 'quail-mode))
+ (quail-mode 1))))
+
+;; Set quail-mode to ARG
+(defun viper-set-input-method (arg)
+ (setq viper-mule-hook-flag t) ; just a precaution
+ (let (viper-mule-hook-flag) ; temporarily inactivate viper mule hooks
+ (cond ((and arg (> (prefix-numeric-value arg) 0) default-input-method)
+ ;; activate input method
+ (viper-activate-input-method))
+ (t ; deactivate input method
+ (viper-inactivate-input-method)))
+ ))
+
;; VI-style Undo
;; Remember the number of characters that have to be deleted in replace
;; mode to compensate for the inserted characters.
(viper-deflocalvar viper-replace-chars-to-delete 0 "")
-(viper-deflocalvar viper-replace-chars-deleted 0 "")
+;; This variable is used internally by the before/after changed functions to
+;; determine how many chars were deleted by the change. This can't be
+;; determined inside after-change-functions because those get the length of the
+;; deleted region, not the number of chars deleted (which are two different
+;; things under MULE).
+(viper-deflocalvar viper-replace-region-chars-deleted 0 "")
;; Insertion ring and command ring
(defcustom viper-insertion-ring-size 14
(defvar viper-use-register nil)
-
-;; Variables for Moves and Searches
+;;; Variables for Moves and Searches
;; For use by `;' command.
(defvar viper-f-char nil)
:type 'boolean
:group 'viper)
-(viper-deflocalvar viper-ex-style-editing-in-insert t "")
-(defcustom viper-ex-style-editing-in-insert t
- "*If t, `Backspace' and `Delete' don't cross line boundaries in insert, etc.
+(viper-deflocalvar viper-ex-style-editing t "")
+(defcustom viper-ex-style-editing t
+ "*If t, Ex-style behavior while editing in Vi command and insert states.
+`Backspace' and `Delete' don't cross line boundaries in insert.
+`X' and `x' can't delete characters across line boundary in Vi, etc.
Note: this doesn't preclude `Backspace' and `Delete' from deleting characters
-by moving past the insertion point. This is a feature, not a bug."
+by moving past the insertion point. This is a feature, not a bug.
+
+If nil, the above commands can work across lines."
:type 'boolean
:group 'viper)
-(viper-deflocalvar viper-ESC-moves-cursor-back viper-ex-style-editing-in-insert "")
+(viper-deflocalvar viper-ESC-moves-cursor-back viper-ex-style-editing "")
(defcustom viper-ESC-moves-cursor-back nil
"*If t, ESC moves cursor back when changing from insert to vi state.
-If nil, the cursor stays where it was."
+If nil, the cursor stays where it was when ESC was hit."
:type 'boolean
:group 'viper)
(defvar ex-unix-type-shell)
(defvar ex-unix-type-shell-options)
(defvar viper-ex-tmp-buf-name)
+(defvar viper-syntax-preference)
(require 'cl)
(require 'ring)
(goto-char cur-pos)
result))
+;; Emacs counts each multibyte character as several positions in the buffer, so
+;; we use Emacs' chars-in-region. XEmacs is counting each char as just one pos,
+;; so we can simply subtract.
+(defun viper-chars-in-region (beg end &optional preserve-sign)
+ (let ((count (abs (if (fboundp 'chars-in-region)
+ (chars-in-region beg end)
+ (- end beg)))))
+ (if (and (< end beg) preserve-sign)
+ (- count)
+ count)))
+
+;; Test if POS is between BEG and END
+(defsubst viper-pos-within-region (pos beg end)
+ (and (>= pos (min beg end)) (>= (max beg end) pos)))
+
;; Like move-marker but creates a virgin marker if arg isn't already a marker.
;; The first argument must eval to a variable name.
;;; Movement utilities
-(defcustom viper-syntax-preference 'strict-vi
- "*Syntax type characterizing Viper's alphanumeric symbols.
-`emacs' means only word constituents are considered to be alphanumeric.
-Word constituents are symbols specified as word constituents by the current
-syntax table.
-`extended' means word and symbol constituents.
-`reformed-vi' means Vi-ish behavior: word constituents and the symbol `_'.
-However, word constituents are determined according to Emacs syntax tables,
-which may be different from Vi in some major modes.
-`strict-vi' means Viper words are exactly as in Vi."
- :type '(radio (const strict-vi) (const reformed-vi)
- (const extended) (const emacs))
- :group 'viper)
+;; Characters that should not be considered as part of the word, in reformed-vi
+;; syntax mode.
+(defconst viper-non-word-characters-reformed-vi
+ "!@#$%^&*()-+=|\\~`{}[];:'\",<.>/?")
+;; These are characters that are not to be considered as parts of a word in
+;; Viper.
+;; Set each time state changes and at loading time
+(viper-deflocalvar viper-non-word-characters nil)
+;; must be buffer-local
(viper-deflocalvar viper-ALPHA-char-class "w"
"String of syntax classes characterizing Viper's alphanumeric symbols.
In addition, the symbol `_' may be considered alphanumeric if
-`viper-syntax-preference'is `reformed-vi'.")
+`viper-syntax-preference' is `strict-vi' or `reformed-vi'.")
-(viper-deflocalvar viper-strict-ALPHA-chars "a-zA-Z0-9_"
+(defconst viper-strict-ALPHA-chars "a-zA-Z0-9_"
+ "Regexp matching the set of alphanumeric characters acceptable to strict
+Vi.")
+(defconst viper-strict-SEP-chars " \t\n"
"Regexp matching the set of alphanumeric characters acceptable to strict
Vi.")
-(viper-deflocalvar viper-strict-SEP-chars " \t\n"
+(defconst viper-strict-SEP-chars-sans-newline " \t"
"Regexp matching the set of alphanumeric characters acceptable to strict
Vi.")
-(viper-deflocalvar viper-SEP-char-class " -"
+(defconst viper-SEP-char-class " -"
"String of syntax classes for Vi separators.
Usually contains ` ', linefeed, TAB or formfeed.")
-(defun viper-update-alphanumeric-class ()
- "Set the syntax class of Viper alphanumerals according to `viper-syntax-preference'.
-Must be called in order for changes to `viper-syntax-preference' to take effect."
+
+;; Set Viper syntax classes and related variables according to
+;; `viper-syntax-preference'.
+(defun viper-update-syntax-classes (&optional set-default)
+ (let ((preference (cond ((eq viper-syntax-preference 'emacs)
+ "w") ; Viper words have only Emacs word chars
+ ((eq viper-syntax-preference 'extended)
+ "w_") ; Viper words have Emacs word & symbol chars
+ (t "w"))) ; Viper words are Emacs words plus `_'
+ (non-word-chars (cond ((eq viper-syntax-preference 'reformed-vi)
+ (viper-string-to-list
+ viper-non-word-characters-reformed-vi))
+ (t nil))))
+ (if set-default
+ (setq-default viper-ALPHA-char-class preference
+ viper-non-word-characters non-word-chars)
+ (setq viper-ALPHA-char-class preference
+ viper-non-word-characters non-word-chars))
+ ))
+
+;; SYMBOL is used because customize requires it, but it is ignored, unless it
+;; is `nil'. If nil, use setq.
+(defun viper-set-syntax-preference (&optional symbol value)
+ "Set Viper syntax preference.
+If called interactively or if SYMBOL is nil, sets syntax preference in current
+buffer. If called non-interactively, preferably via the customization widget,
+sets the default value."
(interactive)
- (setq-default
- viper-ALPHA-char-class
- (cond ((eq viper-syntax-preference 'emacs) "w") ; only word constituents
- ((eq viper-syntax-preference 'extended) "w_") ; word & symbol chars
- (t "w")))) ; vi syntax: word constituents and the symbol `_'
+ (or value
+ (setq value
+ (completing-read
+ "Viper syntax preference: "
+ '(("strict-vi") ("reformed-vi") ("extended") ("emacs"))
+ nil 'require-match)))
+ (if (stringp value) (setq value (intern value)))
+ (or (memq value '(strict-vi reformed-vi extended emacs))
+ (error "Invalid Viper syntax preference, %S" value))
+ (if symbol
+ (setq-default viper-syntax-preference value)
+ (setq viper-syntax-preference value))
+ (viper-update-syntax-classes))
+
+(defcustom viper-syntax-preference 'reformed-vi
+ "*Syntax type characterizing Viper's alphanumeric symbols.
+Affects movement and change commands that deal with Vi-style words.
+Works best when set in the hooks to various major modes.
+
+`strict-vi' means Viper words are (hopefully) exactly as in Vi.
+
+`reformed-vi' means Viper words are like Emacs words \(as determined using
+Emacs syntax tables, which are different for different major modes\) with two
+exceptions: the symbol `_' is always part of a word and typical Vi non-word
+symbols, such as `,',:,\",),{, etc., are excluded.
+This behaves very close to `strict-vi', but also works well with non-ASCII
+characters from various alphabets.
+
+`extended' means Viper word constituents are symbols that are marked as being
+parts of words OR symbols in Emacs syntax tables.
+This is most appropriate for major modes intended for editing programs.
+
+`emacs' means Viper words are the same as Emacs words as specified by Emacs
+syntax tables.
+This option is appropriate if you like Emacs-style words."
+ :type '(radio (const strict-vi) (const reformed-vi)
+ (const extended) (const emacs))
+ :set 'viper-set-syntax-preference
+ :group 'viper)
+(make-variable-buffer-local 'viper-syntax-preference)
+
;; addl-chars are characters to be temporarily considered as alphanumerical
(defun viper-looking-at-alpha (&optional addl-chars)
(if char
(if (eq viper-syntax-preference 'strict-vi)
(looking-at (concat "[" viper-strict-ALPHA-chars addl-chars "]"))
- (or (memq char
- ;; convert string to list
- (append (vconcat addl-chars) nil))
- (memq (char-syntax char)
- (append (vconcat viper-ALPHA-char-class) nil)))))
+ (or
+ ;; or one of the additional chars being asked to include
+ (memq char (viper-string-to-list addl-chars))
+ (and
+ ;; not one of the excluded word chars
+ (not (memq char viper-non-word-characters))
+ ;; char of the Viper-word syntax class
+ (memq (char-syntax char)
+ (viper-string-to-list viper-ALPHA-char-class))))))
))
(defun viper-looking-at-separator ()
(let ((char (char-after (point))))
(if char
- (or (eq char ?\n) ; RET is always a separator in Vi
- (memq (char-syntax char)
- (append (vconcat viper-SEP-char-class) nil))))))
+ (if (eq viper-syntax-preference 'strict-vi)
+ (memq char (viper-string-to-list viper-strict-SEP-chars))
+ (or (eq char ?\n) ; RET is always a separator in Vi
+ (memq (char-syntax char)
+ (viper-string-to-list viper-SEP-char-class)))))
+ ))
(defsubst viper-looking-at-alphasep (&optional addl-chars)
(or (viper-looking-at-separator) (viper-looking-at-alpha addl-chars)))
;; weird syntax tables may confuse strict-vi style
(defsubst viper-skip-all-separators-forward (&optional within-line)
- (viper-skip-syntax 'forward
- viper-SEP-char-class
- (or within-line "\n")
- (if within-line (viper-line-pos 'end))))
+ (if (eq viper-syntax-preference 'strict-vi)
+ (if within-line
+ (skip-chars-forward viper-strict-SEP-chars-sans-newline)
+ (skip-chars-forward viper-strict-SEP-chars))
+ (viper-skip-syntax 'forward
+ viper-SEP-char-class
+ (or within-line "\n")
+ (if within-line (viper-line-pos 'end)))))
(defsubst viper-skip-all-separators-backward (&optional within-line)
- (viper-skip-syntax 'backward
- viper-SEP-char-class
- (or within-line "\n")
- (if within-line (viper-line-pos 'start))))
+ (if (eq viper-syntax-preference 'strict-vi)
+ (if within-line
+ (skip-chars-backward viper-strict-SEP-chars-sans-newline)
+ (skip-chars-backward viper-strict-SEP-chars))
+ (viper-skip-syntax 'backward
+ viper-SEP-char-class
+ (or within-line "\n")
+ (if within-line (viper-line-pos 'start)))))
(defun viper-skip-nonseparators (direction)
- (let ((func (intern (format "skip-syntax-%S" direction))))
- (funcall func (concat "^" viper-SEP-char-class)
- (viper-line-pos (if (eq direction 'forward) 'end 'start)))))
+ (viper-skip-syntax
+ direction
+ (concat "^" viper-SEP-char-class)
+ nil
+ (viper-line-pos (if (eq direction 'forward) 'end 'start))))
+
+;; skip over non-word constituents and non-separators
(defun viper-skip-nonalphasep-forward ()
(if (eq viper-syntax-preference 'strict-vi)
(skip-chars-forward
(concat "^" viper-strict-SEP-chars viper-strict-ALPHA-chars))
- (skip-syntax-forward
- (concat
- "^" viper-ALPHA-char-class viper-SEP-char-class) (viper-line-pos 'end))))
+ (viper-skip-syntax
+ 'forward
+ (concat "^" viper-ALPHA-char-class viper-SEP-char-class)
+ ;; Emacs may consider some of these as words, but we don't want them
+ viper-non-word-characters
+ (viper-line-pos 'end))))
(defun viper-skip-nonalphasep-backward ()
(if (eq viper-syntax-preference 'strict-vi)
(skip-chars-backward
(concat "^" viper-strict-SEP-chars viper-strict-ALPHA-chars))
- (skip-syntax-backward
- (concat
- "^"
- viper-ALPHA-char-class viper-SEP-char-class)
+ (viper-skip-syntax
+ 'backward
+ (concat "^" viper-ALPHA-char-class viper-SEP-char-class)
+ ;; Emacs may consider some of these as words, but we don't want them
+ viper-non-word-characters
(viper-line-pos 'start))))
;; Skip SYNTAX like skip-syntax-* and ADDL-CHARS like skip-chars-*
;; Return the number of chars traveled.
-;; Either SYNTAX or ADDL-CHARS can be nil, in which case they are interpreted
-;; as an empty string.
+;; Both SYNTAX or ADDL-CHARS can be strings or lists of characters.
+;; When SYNTAX is "w", then viper-non-word-characters are not considered to be
+;; words, even if Emacs syntax table says they are.
(defun viper-skip-syntax (direction syntax addl-chars &optional limit)
(let ((total 0)
(local 1)
- (skip-chars-func (intern (format "skip-chars-%S" direction)))
- (skip-syntax-func (intern (format "skip-syntax-%S" direction))))
- (or (stringp addl-chars) (setq addl-chars ""))
- (or (stringp syntax) (setq syntax ""))
+ (skip-chars-func
+ (if (eq direction 'forward)
+ 'skip-chars-forward 'skip-chars-backward))
+ (skip-syntax-func
+ (if (eq direction 'forward)
+ 'viper-forward-char-carefully 'viper-backward-char-carefully))
+ char-looked-at syntax-of-char-looked-at negated-syntax)
+ (setq addl-chars
+ (cond ((listp addl-chars) (viper-charlist-to-string addl-chars))
+ ((stringp addl-chars) addl-chars)
+ (t "")))
+ (setq syntax
+ (cond ((listp syntax) syntax)
+ ((stringp syntax) (viper-string-to-list syntax))
+ (t nil)))
+ (if (memq ?^ syntax) (setq negated-syntax t))
+
(while (and (not (= local 0)) (not (eobp)))
+ (setq char-looked-at (viper-char-at-pos direction)
+ ;; if outside the range, set to nil
+ syntax-of-char-looked-at (if char-looked-at
+ (char-syntax char-looked-at)))
(setq local
- (+ (funcall skip-syntax-func syntax limit)
+ (+ (if (and
+ (cond ((and limit (eq direction 'forward))
+ (< (point) limit))
+ (limit ; backward & limit
+ (> (point) limit))
+ (t t)) ; no limit
+ ;; char under/before cursor has appropriate syntax
+ (if negated-syntax
+ (not (memq syntax-of-char-looked-at syntax))
+ (memq syntax-of-char-looked-at syntax))
+ ;; if char-syntax class is "word", make sure it is not one
+ ;; of the excluded characters
+ (if (and (eq syntax-of-char-looked-at ?w)
+ (not negated-syntax))
+ (not (memq char-looked-at viper-non-word-characters))
+ t))
+ (funcall skip-syntax-func 1)
+ 0)
(funcall skip-chars-func addl-chars limit)))
(setq total (+ total local)))
total
projects / emacs.git / commitdiff