diff --git a/Makefile b/Makefile index 6286f18f2..78f1724b2 100644 --- a/Makefile +++ b/Makefile @@ -65,6 +65,7 @@ lint: .qlot/bin/sblint extensions/lua-mode/lem-lua-mode.asd .qlot/bin/sblint extensions/makefile-mode/lem-makefile-mode.asd .qlot/bin/sblint extensions/markdown-mode/lem-markdown-mode.asd + .qlot/bin/sblint extensions/multiple-cursors/lem-multiple-cursors.asd .qlot/bin/sblint extensions/nim-mode/lem-nim-mode.asd .qlot/bin/sblint extensions/ocaml-mode/lem-ocaml-mode.asd .qlot/bin/sblint extensions/paredit-mode/lem-paredit-mode.asd diff --git a/extensions/multiple-cursors/lem-multiple-cursors.asd b/extensions/multiple-cursors/lem-multiple-cursors.asd new file mode 100644 index 000000000..a35fe1efe --- /dev/null +++ b/extensions/multiple-cursors/lem-multiple-cursors.asd @@ -0,0 +1,4 @@ +(defsystem "lem-multiple-cursors" + :depends-on (:lem) + :serial t + :components ((:file "multiple-cursors"))) diff --git a/extensions/multiple-cursors/multiple-cursors.lisp b/extensions/multiple-cursors/multiple-cursors.lisp new file mode 100644 index 000000000..2f1221b38 --- /dev/null +++ b/extensions/multiple-cursors/multiple-cursors.lisp @@ -0,0 +1,98 @@ +(defpackage :lem-multiple-cursors + (:use :cl :lem) + (:import-from :lem/isearch + :isearch-start + :search-next-matched + :isearch-abort + :make-add-char-callback) + (:import-from :lem/buffer/internal + :point-linum + :point-line + :point-change-line) + (:import-from :lem/buffer/line + :line-previous + :line-next) + (:export :add-cursors-to-next-line + :add-cursors-to-previous-line + :mark-next-like-this) + #+sbcl + (:lock t)) +(in-package :lem-multiple-cursors) + +(define-key *global-keymap* "M-C" 'add-cursors-to-next-line) + +(define-command add-cursors-to-next-line () () + "Duplicates the cursor under the currently existing cursors." + (add-cursor-to-line-with-offset 1)) + +(define-command add-cursors-to-previous-line () () + "Duplicates the cursor above the currently existing cursors." + (add-cursor-to-line-with-offset -1)) + +(define-command mark-next-like-this () () + "" + (if (buffer-mark-p (current-buffer)) + (mark-like-this-direction (buffer-mark (current-buffer)) (buffer-point (current-buffer)) + #'search-forward) + (add-cursors-to-next-line))) + +(define-command mark-previous-like-this () () + "" + (if (buffer-mark-p (current-buffer)) + (mark-like-this-direction (buffer-mark (current-buffer)) (buffer-point (current-buffer)) + #'search-backward) + (add-cursors-to-previous-line))) + +(defun add-cursor-to-line-with-offset (offset) + (let ((cursors (buffer-cursors (current-buffer)))) + (loop :for (cursor next-cursor) :on cursors + :do (with-point ((p cursor)) + (when (and (line-offset p offset (point-charpos p)) + (or (null next-cursor) + (not (same-line-p p next-cursor)))) + (make-fake-cursor p)))))) + +(defun clear-duplicate-cursors (buffer) + (loop :for (cursor next-cursor) :on (buffer-cursors buffer) + :when (and next-cursor (and (same-line-p cursor next-cursor) (eq (point-charpos cursor) (point-charpos next-cursor)))) + :do (delete-fake-cursor + (if (eq cursor (buffer-point buffer)) + next-cursor + cursor)))) + +(defun mark-like-this-direction (start end direction) + (isearch-start "" + (make-add-char-callback direction) + direction + (if (equal direction #'search-forward) + #'search-backward + #'search-forward) + (points-to-string start end)) + (dolist (point (buffer-cursors (current-buffer))) + (with-point ((point point)) + (if (search-next-matched point 1) + (progn + (setf (point-charpos point) (point-charpos end)) + (setf cursor (make-fake-cursor point)) + (dotimes (_ (- (point-linum end) (point-linum start))) + (if (equal direction #'search-forward) + (point-change-line point (- (point-linum point) 1) (line-previous (point-line point))) + (point-change-line point (+ (point-linum point) 1) (line-next (point-line point))))) + (setf (point-charpos point) (- (point-charpos point) (- (point-charpos end) (point-charpos start)))) + (set-cursor-mark cursor point)) + (message "No more matches")))) + (isearch-abort)) + +(defun garbage-collection-cursors () + ;; TODO: find a less janky method of preventing multiple cursors from overlapping and typing the same letter twice + (clear-duplicate-cursors (current-buffer)) + (clear-duplicate-cursors (current-buffer))) + +(add-hook *pre-command-hook* 'garbage-collection-cursors) + +(defun clear-cursors-when-aborted () + (let ((string (merge-cursor-killrings (current-buffer)))) + (clear-cursors (current-buffer)) + (copy-to-clipboard-with-killring string))) + +(add-hook *editor-abort-hook* 'clear-cursors-when-aborted) diff --git a/lem.asd b/lem.asd index e9463bf41..915b008e1 100644 --- a/lem.asd +++ b/lem.asd @@ -150,7 +150,6 @@ (:file "project" :depends-on ("file")) (:file "buffer") (:file "window" :depends-on ("move")) - (:file "multiple-cursors") (:file "process") (:file "help") (:file "font") @@ -263,7 +262,8 @@ "lem-terminal" "lem-legit" "lem-dashboard" - "lem-copilot")) + "lem-copilot" + "lem-multiple-cursors")) (defsystem "lem/executable" :build-operation program-op diff --git a/src/commands/multiple-cursors.lisp b/src/commands/multiple-cursors.lisp deleted file mode 100644 index 078289e6e..000000000 --- a/src/commands/multiple-cursors.lisp +++ /dev/null @@ -1,38 +0,0 @@ -(defpackage :lem-core/commands/multiple-cursors - (:use :cl :lem-core) - (:export :add-cursors-to-next-line) - #+sbcl - (:lock t)) -(in-package :lem-core/commands/multiple-cursors) - -(define-key *global-keymap* "M-C" 'add-cursors-to-next-line) - -(define-command add-cursors-to-next-line () () - "Duplicates the cursor under the currently existing cursors." - (let ((cursors (buffer-cursors (current-buffer)))) - (loop :for (cursor next-cursor) :on cursors - :do (with-point ((p cursor)) - (when (and (line-offset p 1 (point-charpos p)) - (or (null next-cursor) - (not (same-line-p p next-cursor)))) - (make-fake-cursor p)))))) - -(defun clear-duplicate-cursors (buffer) - (loop :for (cursor next-cursor) :on (buffer-cursors buffer) - :when (and next-cursor (same-line-p cursor next-cursor)) - :do (delete-fake-cursor - (if (eq cursor (buffer-point buffer)) - next-cursor - cursor)))) - -(defun garbage-collection-cursors () - (clear-duplicate-cursors (current-buffer))) - -(add-hook *post-command-hook* 'garbage-collection-cursors) - -(defun clear-cursors-when-aborted () - (let ((string (merge-cursor-killrings (current-buffer)))) - (clear-cursors (current-buffer)) - (copy-to-clipboard-with-killring string))) - -(add-hook *editor-abort-hook* 'clear-cursors-when-aborted) diff --git a/src/external-packages.lisp b/src/external-packages.lisp index 899682ab9..46cb6a336 100644 --- a/src/external-packages.lisp +++ b/src/external-packages.lisp @@ -1,7 +1,6 @@ (uiop:define-package :lem (:use :cl) (:use-reexport :lem-core) - (:use-reexport :lem-core/commands/multiple-cursors) (:use-reexport :lem-core/commands/move) (:use-reexport :lem-core/commands/edit) (:use-reexport :lem-core/commands/mark)