Skip to content

Unify vi-mode visual state with lem buffer marks #1817

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.

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

Open
wants to merge 2 commits into
base: main
Choose a base branch
from
Open
Show file tree
Hide file tree
Changes from all commits
Commits
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
34 changes: 18 additions & 16 deletions extensions/vi-mode/commands.lisp
Original file line number Diff line number Diff line change
Expand Up @@ -380,7 +380,7 @@ Move the cursor to the first non-blank character of the line."
(define-operator vi-substitute (beg end type) ("<R>")
(:motion vi-forward-char)
(vi-delete beg end type)
(change-state 'insert))
(setf (buffer-state) 'insert))

(define-operator vi-delete-next-char (beg end type) ("<R>")
(:motion vi-forward-char)
Expand Down Expand Up @@ -447,7 +447,7 @@ Move the cursor to the first non-blank character of the line."
(kill-region-without-appending start end)))

(define-operator vi-change (beg end type) ("<R>")
()
(:move-point nil)
(when (point= beg end)
(return-from vi-change))
(let ((end-with-newline (char= (character-at end -1) #\Newline)))
Expand All @@ -464,7 +464,7 @@ Move the cursor to the first non-blank character of the line."
(t (unless (eql (character-at (current-point)) #\Space)
(skip-whitespace-backward end))
(vi-delete beg end type))))
(change-state 'insert))
(setf (buffer-state) 'insert))

(define-operator vi-change-whole-line (beg end) ("<r>")
(:motion vi-line)
Expand All @@ -476,7 +476,7 @@ Move the cursor to the first non-blank character of the line."
(define-operator vi-change-line (beg end type) ("<R>")
(:motion vi-move-to-end-of-line)
(vi-change beg end type)
(change-state 'insert))
(setf (buffer-state) 'insert))

(define-operator vi-join (start end) ("<r>")
(:motion vi-line)
Expand All @@ -489,7 +489,8 @@ Move the cursor to the first non-blank character of the line."
(delete-next-char))))

(define-operator vi-join-line (start end type) ("<R>")
(:motion vi-line)
(:move-point nil
:motion vi-line)
(when (and (eq type :line)
(point/= start end)
(zerop (point-charpos end)))
Expand Down Expand Up @@ -622,10 +623,11 @@ Move the cursor to the first non-blank character of the line."
"~v@{~C~:*~}~*~@[~%~]"
(length string)
char
(not lastp)))))))
(not lastp))))))
(to-start (visual-p)))
(delete-between-points start end)
(insert-string start string-to-replace)
(if (visual-p)
(if to-start
(move-point (current-point) start)
(character-offset (current-point) *cursor-offset*)))))

Expand Down Expand Up @@ -999,38 +1001,38 @@ on the same line or at eol if there are none."
(delete-active-window))))

(define-command vi-end-insert () ()
(change-state 'normal)
(setf (buffer-state) 'normal)
(vi-backward-char 1))

(define-command vi-insert () ()
(change-state 'insert))
(setf (buffer-state) 'insert))

(define-command vi-insert-line () ()
(vi-move-to-beginning-of-line)
(skip-whitespace-forward (current-point) t)
(change-state 'insert))
(setf (buffer-state) 'insert))

(define-command vi-append () ()
(let ((p (current-point)))
(unless (or (end-line-p p)
(end-buffer-p p))
(forward-char 1))
(change-state 'insert)))
(setf (buffer-state) 'insert)))

(define-command vi-append-line () ()
(line-end (current-point))
(change-state 'insert))
(setf (buffer-state) 'insert))

(define-command vi-open-below () ()
(let ((p (current-point)))
(line-end p)
(change-state 'insert)
(setf (buffer-state) 'insert)
(insert-character p #\Newline)
(indent-line (current-point))))

(define-command vi-open-above () ()
(line-start (current-point))
(change-state 'insert)
(setf (buffer-state) 'insert)
(open-line 1)
(let ((column (with-point ((p (current-point)))
(point-column (or (and (line-offset p 1)
Expand Down Expand Up @@ -1069,7 +1071,7 @@ on the same line or at eol if there are none."
(lem/universal-argument::*argument* (lem/universal-argument::make-arg-state)))
(execute-key-sequence keyseq)
(unless (state= prev-state (current-state))
(change-state prev-state))))))
(setf (buffer-state) prev-state))))))

(define-text-object-command vi-a-word (count) ("p")
(:expand-selection t)
Expand Down Expand Up @@ -1112,7 +1114,7 @@ on the same line or at eol if there are none."
(inner-range-of 'paragraph-object (current-state) count))

(define-command vi-normal () ()
(change-state 'normal))
(setf (buffer-state) 'normal))

(define-command vi-keyboard-quit () ()
(when (eq (current-state) 'modeline)
Expand Down
48 changes: 26 additions & 22 deletions extensions/vi-mode/commands/utils.lisp
Original file line number Diff line number Diff line change
Expand Up @@ -94,9 +94,9 @@
(values () ()))
((eq (first arg-list) '&optional)
(values
arg-list
'("p")
(second (ensure-list (second arg-list)))))
arg-list
'("p")
(second (ensure-list (second arg-list)))))
(t (values arg-list '("P") nil))))

(defmacro define-motion (name arg-list arg-descriptors (&key type jump (repeat :motion) (default-n-arg 1)) &body body)
Expand All @@ -117,7 +117,7 @@
(n (or n
(typecase command
(vi-motion
(vi-motion-default-n-arg command))
(vi-motion-default-n-arg command))
(otherwise 1))))
(lem-core::*universal-argument* n))
(execute (lem-core::get-active-modes-class-instance (current-buffer))
Expand Down Expand Up @@ -178,7 +178,7 @@
((visual-block-p) :block)
(t :exclusive))))))

(defun operator-region (motion &key move-point with-type)
(defun operator-region (motion &key with-type)
(multiple-value-bind (start end type)
(multiple-value-bind (start end type)
(if (visual-p)
Expand All @@ -200,16 +200,7 @@
(multiple-value-prog1
(if with-type
(values start end type)
(values start end))
(when move-point
(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-column start)
(point-column end)))
(move-point (current-point) p))
(move-point (current-point) start))))))
(values start end)))))

(defun call-define-operator (fn &key keep-visual restore-point)
(with-point ((*vi-origin-point* (current-point)))
Expand All @@ -221,16 +212,16 @@
(when (visual-p)
(vi-visual-end)))))))

(defun parse-arg-descriptors (arg-descriptors &key motion move-point)
(defun parse-arg-descriptors (arg-descriptors &key motion)
`(values-list
(append
,@(mapcar (lambda (arg-descriptor)
(if (stringp arg-descriptor)
(cond
((string= arg-descriptor "<r>")
`(multiple-value-list (operator-region ',motion :move-point ,move-point)))
`(multiple-value-list (operator-region ',motion)))
((string= arg-descriptor "<R>")
`(multiple-value-list (operator-region ',motion :move-point ,move-point :with-type t)))
`(multiple-value-list (operator-region ',motion :with-type t)))
((string= arg-descriptor "<v>")
'(multiple-value-list (visual-region)))
((string= arg-descriptor "p")
Expand All @@ -240,15 +231,28 @@
`(multiple-value-list ,arg-descriptor)))
arg-descriptors))))

(defun move-point-to-start (start end mode)
(if (eq mode :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-column start)
(point-column end)))
(move-point (current-point) p))
(move-point (current-point) start)))


(defmacro define-operator (name arg-list arg-descriptors
(&key motion keep-visual (move-point t) (repeat t) restore-point)
&body body)
`(define-command (,name (:advice-classes vi-operator)
(:initargs :repeat ,repeat)) ,arg-list
(,(parse-arg-descriptors arg-descriptors :motion motion :move-point move-point))
(call-define-operator (lambda () ,@body)
:keep-visual ,keep-visual
:restore-point ,restore-point)))
(,(parse-arg-descriptors arg-descriptors :motion motion))
(call-define-operator (lambda () ,@body
(when ,move-point
(move-point-to-start ,(first arg-list) ,(second arg-list) ,(third arg-list))))
:keep-visual ,keep-visual
:restore-point ,restore-point)))

(defun call-define-text-object-command (fn &key expand-selection)
(flet ((expand-visual-range (range)
Expand Down
47 changes: 30 additions & 17 deletions extensions/vi-mode/core.lisp
Original file line number Diff line number Diff line change
Expand Up @@ -15,16 +15,16 @@
:vi-mode
:define-state
:current-state
:current-main-state
:state=
:change-state
:with-state
:with-temporary-state
:mode-specific-keymaps
:pre-command-hook
:post-command-hook
:state-enabled-hook
:state-disabled-hook
:state-changed-hook
:buffer-state
:buffer-state-enabled-hook
:buffer-state-disabled-hook
:vi-this-command-keys
:this-motion-command
:vi-command
Expand Down Expand Up @@ -122,16 +122,23 @@
(defgeneric post-command-hook (state)
(:method ((state vi-state))))

(defgeneric state-enabled-hook (state)
(:method ((state vi-state))))
(defgeneric state-changed-hook (state))

(defgeneric state-disabled-hook (state))
(defgeneric buffer-state-enabled-hook (state buffer)
(:method ((state vi-state) buffer)))

(defmethod state-disabled-hook ((state vi-state)))
(defgeneric buffer-state-disabled-hook (state buffer)
(:method ((state vi-state) buffer)))

(defun current-state ()
*current-state*)

(defun (setf current-state) (state-or-name)
(let ((state (ensure-state state-or-name)))
(setf *current-state* state)
(state-changed-hook state)
(update-cursor-styles state)))

(defun current-main-state ()
"Same as `current-state` except it returns the previous state insinde `with-temporary-state` macro."
(or *current-main-state*
Expand Down Expand Up @@ -166,20 +173,26 @@
(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)
(update-cursor-styles state)))
(defun buffer-state (&optional (buffer (current-buffer)))
(buffer-value buffer :vi-buffer-state))

(defun (setf buffer-state) (state-or-name &optional (buffer (current-buffer)))
(let ((state (ensure-state state-or-name))
(old-state (buffer-state buffer)))
(when (not (equal state old-state))
(when old-state
(buffer-state-disabled-hook old-state buffer))
(buffer-state-enabled-hook state buffer)
(setf (buffer-value buffer :vi-buffer-state) state))
(when (eq buffer (current-buffer))
(setf (current-state) state))))

(defmacro with-state (state &body body)
(with-gensyms (old-state)
`(let ((,old-state (current-state)))
(change-state ,state)
(setf (current-state) ,state)
(unwind-protect (progn ,@body)
(change-state ,old-state)))))
(setf (current-state) ,old-state)))))

(defmacro with-temporary-state (state &body body)
`(let ((*current-main-state* *current-state*)
Expand Down
49 changes: 37 additions & 12 deletions extensions/vi-mode/states.lisp
Original file line number Diff line number Diff line change
@@ -1,12 +1,17 @@
(defpackage :lem-vi-mode/states
(:use :cl
:lem)
(:import-from :alexandria
:when-let
:when-let*)
(:import-from :lem-vi-mode/core
:define-state
:*enable-hook*
:*disable-hook*
:change-state
:state-enabled-hook
:current-state
:buffer-state
:state-changed-hook
:ensure-state
:define-keymap)
(:import-from :lem-vi-mode/modeline
:state-modeline-yellow
Expand All @@ -28,7 +33,7 @@
:replace-state))
(in-package :lem-vi-mode/states)

(defmethod state-enabled-hook :after (state)
(defmethod state-changed-hook (state) :after
(change-element-by-state state))

;;
Expand Down Expand Up @@ -102,19 +107,39 @@
;;
;; Setup hooks

(defun enable-normal-state ()
(change-state 'normal))
(defun enable-vi-modeline-state ()
(change-state 'vi-modeline))
(defun enter-prompt ()
(setf (buffer-state) 'vi-modeline))
(defun exit-prompt ()
(when-let* ((cb (window-buffer (current-window)))
(state (buffer-state cb)))
(setf (current-state) state)))

(defun vi-switch-to-buffer (&optional (buffer (current-buffer)))
(let ((buffer-state (buffer-state buffer)))
(if buffer-state
(setf (current-state) buffer-state)
(let ((n (ensure-state 'normal)))
(setf (buffer-state buffer) n)))))

(defun vi-switch-to-window (old new)
(declare (ignore old))
(when-let ((state (buffer-state (window-buffer new))))
(setf (current-state) state)))

(defun vi-enable-hook ()
(change-state 'normal)
(add-hook *prompt-activate-hook* 'enable-vi-modeline-state)
(add-hook *prompt-deactivate-hook* 'enable-normal-state))
(setf *region-end-offset* -1)
(setf (current-state) (or (buffer-state (current-buffer)) (ensure-state 'normal)))
(add-hook *switch-to-buffer-hook* 'vi-switch-to-buffer)
(add-hook *switch-to-window-hook* 'vi-switch-to-window)
(add-hook *prompt-after-activate-hook* 'enter-prompt)
(add-hook *prompt-deactivate-hook* 'exit-prompt))

(defun vi-disable-hook ()
(remove-hook *prompt-activate-hook* 'enable-vi-modeline-state)
(remove-hook *prompt-deactivate-hook* 'enable-normal-state))
(setf *region-end-offset* 0)
(remove-hook *switch-to-buffer-hook* 'vi-switch-to-buffer)
(remove-hook *switch-to-window-hook* 'vi-switch-to-window)
(remove-hook *prompt-after-activate-hook* 'enter-prompt)
(remove-hook *prompt-deactivate-hook* 'exit-prompt))

(add-hook *enable-hook* 'vi-enable-hook)
(add-hook *disable-hook* 'vi-disable-hook)
2 changes: 1 addition & 1 deletion extensions/vi-mode/tests/kbdmacro.lisp
Original file line number Diff line number Diff line change
Expand Up @@ -62,4 +62,4 @@
(handler-case
(cmd "10@a")
(end-of-buffer ()))
(ok (buf= #?"set-command\nset-command\nset-command\nset[]")))))
(ok (buf= #?"set-command\nset-command\nset-command\nse[t]")))))
Loading