diff --git a/extensions/vi-mode/commands.lisp b/extensions/vi-mode/commands.lisp index 454f897e2..af4060684 100644 --- a/extensions/vi-mode/commands.lisp +++ b/extensions/vi-mode/commands.lisp @@ -445,24 +445,21 @@ (move-point (current-point) p)))))) (defun read-key-to-replace () - (unwind-protect (progn - (change-state 'replace-state) - (let ((command (read-command))) - (unless command - (escape)) - (call-command command (universal-argument-of-this-command)))) - (change-state 'normal))) + (with-temporary-state 'replace-state + (let ((command (read-command))) + (unless command + (escape)) + (call-command command (universal-argument-of-this-command))))) (define-operator vi-replace-char (start end type char) ("" (read-key-to-replace)) (:motion vi-forward-char - :restore-point t) + :move-point nil) (if (eq type :block) (progn (apply-visual-range (lambda (start end) (vi-replace-char start end :inclusive char))) - (move-point (current-point) start) - (character-offset (current-point) *cursor-offset*)) + (move-point (current-point) start)) (let ((string-to-replace ;; Replace all chars in the region except newlines (with-output-to-string (s) diff --git a/extensions/vi-mode/commands/utils.lisp b/extensions/vi-mode/commands/utils.lisp index 8bd17096a..dafc8e2c3 100644 --- a/extensions/vi-mode/commands/utils.lisp +++ b/extensions/vi-mode/commands/utils.lisp @@ -10,7 +10,7 @@ :vi-operator :vi-text-object :current-state - :change-state + :with-temporary-state :range :make-range :range-beginning @@ -48,7 +48,6 @@ (in-package :lem-vi-mode/commands/utils) (defvar *cursor-offset* -1) -(defvar *operator-pending-mode* nil) (defun bolp (point) "Return t if POINT is at the beginning of a line." @@ -72,7 +71,7 @@ (goto-eol point))) (defun operator-pending-mode-p () - *operator-pending-mode*) + (typep (current-state) 'operator)) (defun read-universal-argument () (loop :for key := (read-key) @@ -86,10 +85,7 @@ (defmethod execute :around (mode (command vi-operator) uarg) (declare (ignore mode uarg)) - ;; XXX: This flag will be rewritten as a code to check the current state - ;; when operator-pending state is implemented. - (let ((*operator-pending-mode* t) - (*this-motion-command* nil)) + (let ((*this-motion-command* nil)) (handler-case (call-next-method) (operator-abort ())))) @@ -156,26 +152,22 @@ (if motion (let ((command (get-command motion))) (call-motion command (universal-argument-of-this-command))) - (let ((state (current-state))) - (unwind-protect - (progn - (change-state 'operator) - (let* ((uarg (* (or (universal-argument-of-this-command) 1) (or (read-universal-argument) 1))) - (command-name (read-command)) - (command (get-command command-name))) - (typecase command - (vi-operator - (if (eq command-name (command-name (this-command))) - ;; Recursive call of the operator like 'dd', 'cc' - (save-excursion - (ignore-some-conditions (end-of-buffer) - (next-logical-line (1- (or uarg 1)))) - (values start (copy-point (current-point)) :line)) - ;; Ignore an invalid operator (like 'dJ') - nil)) - (otherwise - (call-motion command uarg))))) - (change-state state))))))) + (with-temporary-state 'operator + (let* ((uarg (* (or (universal-argument-of-this-command) 1) (or (read-universal-argument) 1))) + (command-name (read-command)) + (command (get-command command-name))) + (typecase command + (vi-operator + (if (eq command-name (command-name (this-command))) + ;; Recursive call of the operator like 'dd', 'cc' + (save-excursion + (ignore-some-conditions (end-of-buffer) + (next-logical-line (1- (or uarg 1)))) + (values start (copy-point (current-point)) :line)) + ;; Ignore an invalid operator (like 'dJ') + nil)) + (otherwise + (call-motion command uarg))))))))) (defun visual-region () (if (visual-p) @@ -194,7 +186,8 @@ (if (visual-p) (visual-region) (motion-region motion)) - (when (point< end start) + (when (and (not (eq type :block)) + (point< end start)) (rotatef start end)) (ecase type (:line (unless (visual-p) @@ -211,7 +204,14 @@ (values start end type) (values start end)) (when move-point - (move-point (current-point) start))))) + (if (eq type :block) + (with-point ((p (current-point))) + (move-to-line p (min (line-number-at-point start) + (line-number-at-point end))) + (move-to-column p (min (point-charpos start) + (point-charpos end))) + (move-point (current-point) p)) + (move-point (current-point) start)))))) (defun call-define-operator (fn &key keep-visual restore-point) (with-point ((*vi-origin-point* (current-point))) diff --git a/extensions/vi-mode/core.lisp b/extensions/vi-mode/core.lisp index 70f0c6580..9b852d7af 100644 --- a/extensions/vi-mode/core.lisp +++ b/extensions/vi-mode/core.lisp @@ -18,6 +18,7 @@ :state= :change-state :with-state + :with-temporary-state :mode-specific-keymaps :pre-command-hook :post-command-hook @@ -150,14 +151,19 @@ ;; Precede state keymaps over major-mode keymaps (state-keymaps (ensure-state *current-state*))))) +(defun update-cursor-styles (state) + (set-attribute 'cursor + :background (or (state-cursor-color state) *default-cursor-color*)) + (lem-if:update-cursor-shape (lem:implementation) + (state-cursor-type state))) + (defun change-state (name) (and *current-state* (state-disabled-hook *current-state*)) (let ((state (ensure-state name))) (setf *current-state* state) (state-enabled-hook state) - (set-attribute 'cursor - :background (or (state-cursor-color state) *default-cursor-color*)))) + (update-cursor-styles state))) (defmacro with-state (state &body body) (with-gensyms (old-state) @@ -166,6 +172,14 @@ (unwind-protect (progn ,@body) (change-state ,old-state))))) +(defmacro with-temporary-state (state &body body) + (with-gensyms (old-state) + `(let ((,old-state *current-state*) + (*current-state* (ensure-state ,state))) + (update-cursor-styles *current-state*) + (unwind-protect (progn ,@body) + (update-cursor-styles ,old-state))))) + (defun vi-pre-command-hook () (when (mode-active-p (current-buffer) 'vi-mode) (pre-command-hook (ensure-state (current-state))))) @@ -177,10 +191,6 @@ (add-hook *pre-command-hook* 'vi-pre-command-hook) (add-hook *post-command-hook* 'vi-post-command-hook) -(defmethod state-enabled-hook :after ((state vi-state)) - (lem-if:update-cursor-shape (lem:implementation) - (state-cursor-type state))) - (defun vi-this-command-keys () (append (and (numberp (universal-argument-of-this-command)) diff --git a/extensions/vi-mode/tests/operator.lisp b/extensions/vi-mode/tests/operator.lisp index 4bdfdb2b7..7e654a845 100644 --- a/extensions/vi-mode/tests/operator.lisp +++ b/extensions/vi-mode/tests/operator.lisp @@ -109,6 +109,39 @@ (cmd "jlp") (ok (buf= #?"abcd\nefgbc[d]h\n"))))) +(deftest vi-replace-char + (with-fake-interface () + (with-vi-buffer ("a[n]t") + (cmd "rr") + (ok (buf= "a[r]t"))) + (with-vi-buffer ("sh[o]ut") + (cmd "2re") + (ok (buf= "she[e]t"))) + (with-vi-buffer ("<[m]>eat") + (cmd "rb") + (ok (buf= "[b]eat"))) + (with-vi-buffer ("pk") + (cmd "re") + (ok (buf= "p[e]ek"))) + (with-vi-buffer ("p<[i]c>k") + (cmd "re") + (ok (buf= "p[e]ek"))) + (with-vi-buffer (#?"em[a]cs\n") + (cmd "VrX") + (ok (buf= #?"[X]XXXX\n"))) + (with-vi-buffer (#?"a[b]cd\nefgh\n") + (cmd "jlrx") + (ok (buf= #?"a[x]xd\nexxh\n"))) + (with-vi-buffer (#?"ab[c]d\nefgh\n") + (cmd "jhrx") + (ok (buf= #?"a[x]xd\nexxh\n"))) + (with-vi-buffer (#?"abcd\nef[g]h\n") + (cmd "khrx") + (ok (buf= #?"a[x]xd\nexxh\n"))) + (with-vi-buffer (#?"abcd\ne[f]gh\n") + (cmd "klrx") + (ok (buf= #?"a[x]xd\nexxh\n"))))) + (deftest vi-repeat (with-fake-interface () (with-vi-buffer (#?"[1]:abc\n2:def\n3:ghi\n4:jkl\n5:mno\n6:opq\n7:rst\n8:uvw") diff --git a/extensions/vi-mode/text-objects.lisp b/extensions/vi-mode/text-objects.lisp index 5970723a5..dc13c18b7 100644 --- a/extensions/vi-mode/text-objects.lisp +++ b/extensions/vi-mode/text-objects.lisp @@ -73,7 +73,7 @@ (defmethod a-range-of (object (state visual) count) (destructuring-bind (beg end) (visual-range) - (when (point= beg end) + (when (point= beg (current-point)) (return-from a-range-of (call-next-method))) (let ((direction (cond @@ -132,7 +132,7 @@ (defmethod inner-range-of (object (state visual) count) (destructuring-bind (beg end) (visual-range) - (when (point= beg end) + (when (point= beg (current-point)) (return-from inner-range-of (call-next-method))) (let ((direction (cond diff --git a/extensions/vi-mode/visual.lisp b/extensions/vi-mode/visual.lisp index ed6a67fab..d5156a473 100644 --- a/extensions/vi-mode/visual.lisp +++ b/extensions/vi-mode/visual.lisp @@ -156,21 +156,33 @@ (typep (current-state) 'visual-block)) (defun visual-range () - (if (or (visual-char-p) - (visual-block-p)) - (with-point ((start *start-point*) - (end (current-point))) - (cond - ((point< start end) - (character-offset end 1)) - ((point< end start) - (character-offset start 1))) - (list start end)) - (let ((ov (sort (copy-list *visual-overlays*) #'point< :key #'overlay-start))) - (assert (null (rest ov))) - (list - (overlay-start (first ov)) - (overlay-end (first ov)))))) + (cond + ((visual-char-p) + (with-point ((start *start-point*) + (end (current-point))) + (cond ((point<= start end) + (character-offset end 1)) + ((point< end start) + (character-offset start 1))) + (list start end))) + ((visual-block-p) + ;; Return left-top point and right-bottom point + (with-point ((start *start-point*) + (end (current-point))) + (map nil #'move-to-line + (list start end) + (sort (mapcar #'line-number-at-point (list start end)) #'<)) + (map nil #'move-to-column + (list start end) + (sort (mapcar #'point-charpos (list *start-point* (current-point))) #'<)) + (character-offset end 1) + (list start end))) + (t + (let ((ov (sort (copy-list *visual-overlays*) #'point< :key #'overlay-start))) + (assert (null (rest ov))) + (list + (overlay-start (first ov)) + (overlay-end (first ov))))))) (defun (setf visual-range) (new-range) (check-type new-range list)