Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Switch between visual modes without resetting the starting point #976

Merged
merged 1 commit into from
Aug 20, 2023
+109 −40
Merged

Switch between visual modes without resetting the starting point #976

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
1 commit
Select commit
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
7 changes: 5 additions & 2 deletions extensions/vi-mode/lem-vi-mode.asd
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -37,7 +37,10 @@
"alexandria")
:components
((:module "tests"
:depends-on ("utils")
:components
((:file "motion" :depends-on ("utils"))
(:file "utils"))))
((:file "motion")
(:file "visual")))
(:file "utils"
:pathname "tests/utils"))
:perform (test-op (op c) (symbol-call :rove '#:run c)))
61 changes: 38 additions & 23 deletions extensions/vi-mode/tests/utils.lisp
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -31,6 +31,7 @@
:pos=
:text=
:state=
:visual=
:buf=))
(in-package :lem-vi-mode/tests/utils)

Expand Down Expand Up @@ -101,27 +102,30 @@
(subseq buffer-text buffer-pos)))))))
(if (lem-vi-mode/visual:visual-p)
(let ((read-pos 0))
(with-output-to-string (s)
(apply-visual-range
(lambda (start end)
(write-string buf-str s
:start read-pos
:end (1- (if (< buffer-pos (position-at-point start))
(+ (position-at-point start) 2)
(position-at-point start))))
(write-char #\< s)
(write-string buf-str s
:start (1- (if (< buffer-pos (position-at-point start))
(+ (position-at-point start) 2)
(position-at-point start)))
:end (1- (if (< buffer-pos (position-at-point end))
(+ (position-at-point end) 2)
(position-at-point end))))
(write-char #\> s)
(setf read-pos
(if (< buffer-pos (position-at-point end))
(+ (position-at-point end) 2)
(position-at-point end)))))))
(concatenate
'string
(with-output-to-string (s)
(apply-visual-range
(lambda (start end)
(write-string buf-str s
:start read-pos
:end (1- (if (< buffer-pos (position-at-point start))
(+ (position-at-point start) 2)
(position-at-point start))))
(write-char #\< s)
(write-string buf-str s
:start (1- (if (< buffer-pos (position-at-point start))
(+ (position-at-point start) 2)
(position-at-point start)))
:end (1- (if (< buffer-pos (position-at-point end))
(+ (position-at-point end) 2)
(position-at-point end))))
(write-char #\> s)
(setf read-pos
(if (< buffer-pos (position-at-point end))
(+ (position-at-point end) 2)
(position-at-point end))))))
(subseq buf-str (1- read-pos))))
buf-str))))

(defun make-buffer-string (buffer)
Expand Down Expand Up @@ -278,14 +282,25 @@
(eq (keyword-to-state expected-state)
(current-state)))

(defun visual= (visual-regions)
(let (current-regions)
(apply-visual-range
(lambda (start end)
(push
(cons (position-at-point start)
(position-at-point end))
current-regions)))
(equalp (nreverse current-regions) visual-regions)))

(defun buf= (expected-buffer-string)
(check-type expected-buffer-string string)
(multiple-value-bind (expected-buffer-text expected-position)
(multiple-value-bind (expected-buffer-text expected-position visual-regions)
(parse-buffer-string expected-buffer-string)
(with-point ((p (current-point)))
(move-to-position p expected-position)
(and (text= expected-buffer-text)
(pos= p)))))
(pos= p)
(visual= visual-regions)))))

(defmethod form-description ((function (eql 'lem:point=)) args values &key negative)
(multiple-value-bind (expected-line expected-col)
Expand Down
39 changes: 39 additions & 0 deletions extensions/vi-mode/tests/visual.lisp
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -0,0 +1,39 @@
(defpackage :lem-vi-mode/tests/visual
(:use :cl
:lem
:rove
:lem-vi-mode/tests/utils)
(:import-from :lem/common/timer
:with-timer-manager)
(:import-from :lem-core
:lem-timer-manager)
(:import-from :lem-fake-interface
:with-fake-interface)
(:import-from :named-readtables
:in-readtable))
(in-package :lem-vi-mode/tests/visual)

(in-readtable :interpol-syntax)

(deftest visual-switch
(with-timer-manager (make-instance 'lem-timer-manager)
(with-fake-interface ()
(with-vi-buffer (#?"[a]bc\ndef\n")
(cmd "v")
(ok (buf= #?"<[a]>bc\ndef\n"))
(cmd "l")
(ok (buf= #?"<a[b]>c\ndef\n"))
(cmd "v")
(ok (buf= #?"a[b]c\ndef\n"))
(cmd "v")
(ok (buf= #?"a<[b]>c\ndef\n"))
(cmd "V")
(ok (buf= #?"<a[b]c>\ndef\n"))
(cmd "j")
(ok (buf= #?"<abc\nd[e]f>\n"))
(cmd "l<C-v>")
(ok (buf= #?"a<bc>\nd<e[f]>\n"))
(cmd "v")
(ok (buf= #?"a<bc\nde[f]>\n"))
(cmd "v")
(ok (buf= #?"abc\nde[f]\n"))))))
42 changes: 27 additions & 15 deletions extensions/vi-mode/visual.lisp
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -2,6 +2,10 @@
(:use :cl
:lem
:lem-vi-mode/core)
(:import-from :lem-vi-mode/core
:ensure-state)
(:import-from :lem-base
:alive-point-p)
(:export :*visual-keymap*
:vi-visual-end
:vi-visual-char
Expand Down Expand Up @@ -41,6 +45,7 @@

(defmethod state-disabled-hook ((state visual))
(delete-point *start-point*)
(setf *start-point* nil)
(clear-visual-overlays))

(defun disable ()
Expand Down Expand Up @@ -97,34 +102,41 @@
(clear-visual-overlays)
(change-state 'normal))

(defun enable-visual (new-state)
(let ((new-state (ensure-state new-state))
(current-state (current-state)))
(cond
((typep current-state (class-name (class-of new-state)))
(vi-visual-end))
((typep current-state 'visual)
(check-type *start-point* point)
(assert (alive-point-p *start-point*))
(let ((start (copy-point *start-point*)))
(prog1 (change-state new-state)
(setf *start-point* start))))
(t
(change-state new-state)))))

(define-command vi-visual-char () ()
(if (visual-char-p)
(vi-visual-end)
(change-state 'visual-char)))
(enable-visual 'visual-char))

(define-command vi-visual-line () ()
(if (visual-line-p)
(vi-visual-end)
(change-state 'visual-line)))
(enable-visual 'visual-line))

(define-command vi-visual-block () ()
(if (visual-block-p)
(vi-visual-end)
(change-state 'visual-block)))
(enable-visual 'visual-block))

(defun visual-p ()
(or (visual-line-p)
(visual-block-p)
(visual-char-p)))
(typep (current-state) 'visual))

(defun visual-char-p ()
(eq 'visual-char (current-state)))
(typep (current-state) 'visual-char))

(defun visual-line-p ()
(eq 'visual-line (current-state)))
(typep (current-state) 'visual-line))

(defun visual-block-p ()
(eq 'visual-block (current-state)))
(typep (current-state) 'visual-block))

(defun apply-visual-range (function)
(dolist (ov (sort (copy-list *visual-overlays*) #'point< :key #'overlay-start))
Expand Down