diff --git a/extensions/vi-mode/visual.lisp b/extensions/vi-mode/visual.lisp index 24e64aac5..6564b4a94 100644 --- a/extensions/vi-mode/visual.lisp +++ b/extensions/vi-mode/visual.lisp @@ -10,6 +10,11 @@ :normal) (:import-from :lem-vi-mode/modeline :state-modeline-orange) + (:import-from :lem/language-mode + :set-region-point-global) + (:import-from :lem-generics + :global-mode-region-beginning + :global-mode-region-end) (:import-from :lem-base :alive-point-p) (:import-from :alexandria @@ -248,3 +253,25 @@ (move-to-column *start-point* end-col) (move-to-column (current-point) start-col)) (vi-visual-swap-points))) + +(defmethod set-region-point-global ((start point) (end point) + (global-mode vi-mode)) + (declare (ignore global-mode)) + (when (visual-p) + (let ((v-range (visual-range))) + (move-point start (car v-range)) + (move-point end (cadr v-range))))) + +(defmethod global-mode-region-beginning ((global-mode vi-mode) + &optional (buffer (current-buffer))) + (declare (ignore buffer)) + (if (visual-p) + (car (visual-range)) + (editor-error "Not in visual mode"))) + +(defmethod global-mode-region-end ((global-mode vi-mode) + &optional (buffer (current-buffer))) + (declare (ignore buffer)) + (if (visual-p) + (cadr (visual-range)) + (editor-error "Not in visual mode"))) diff --git a/lem.asd b/lem.asd index c8215404b..24977611b 100644 --- a/lem.asd +++ b/lem.asd @@ -63,9 +63,11 @@ (:file "popup") (:file "modeline") (:file "command") - (:file "defcommand") (:file "mode") (:file "keymap") + (:file "defcommand") + (:file "fundamental-mode") + (:file "export-generics") (:file "event-queue") (:file "interp") (:file "mouse") @@ -73,7 +75,6 @@ (:file "input") (:file "overlay") (:file "streams") - (:file "fundamental-mode") (:file "completion") (:file "typeout") (:file "cursors") diff --git a/src/base/basic.lisp b/src/base/basic.lisp index 81dd09336..0d3e6ad8e 100644 --- a/src/base/basic.lisp +++ b/src/base/basic.lisp @@ -257,6 +257,7 @@ The thrid argument PROP is a property to remove." (count-characters (buffer-start-point buffer) (buffer-end-point buffer)))) + (defun region-beginning (&optional (buffer (current-buffer))) "Return the integer value of point or mark, whichever is smaller." (point-min (buffer-point buffer) diff --git a/src/defcommand.lisp b/src/defcommand.lisp index cd53efc53..4a8c5bd37 100644 --- a/src/defcommand.lisp +++ b/src/defcommand.lisp @@ -1,5 +1,9 @@ (in-package :lem-core) +(defun maybe-marked () + (when (string= (mode-name (current-global-mode)) "emacs") + (check-marked))) + (eval-when (:compile-toplevel :load-toplevel) (defun parse-arg-descriptors (arg-descriptors universal-argument) "Parse arg descriptors given to define-command. @@ -50,10 +54,9 @@ :default nil :existing nil))) (#\r - (push '(check-marked) pre-forms) - '(list - (region-beginning) - (region-end))))) + (push '(maybe-marked) pre-forms) + '(list (lem-generics:global-mode-region-beginning (current-global-mode)) + (lem-generics:global-mode-region-end (current-global-mode)))))) ((and (consp arg-descriptor) (eq :splice (first arg-descriptor))) (assert (alexandria:length= arg-descriptor 2)) diff --git a/src/export-generics.lisp b/src/export-generics.lisp new file mode 100644 index 000000000..0ddd5ed63 --- /dev/null +++ b/src/export-generics.lisp @@ -0,0 +1,14 @@ +(in-package :lem-generics) + +(defgeneric global-mode-region-beginning (global-mode &optional buffer)) + +(defmethod global-mode-region-beginning ((global-mode lem-core::emacs-mode) + &optional (buffer (current-buffer))) + (region-beginning buffer)) + + +(defgeneric global-mode-region-end (global-mode &optional buffer)) + +(defmethod global-mode-region-end ((global-mode lem-core::emacs-mode) + &optional (buffer (current-buffer))) + (region-end buffer)) diff --git a/src/ext/language-mode.lisp b/src/ext/language-mode.lisp index e6fdefacd..4f7158696 100644 --- a/src/ext/language-mode.lisp +++ b/src/ext/language-mode.lisp @@ -38,7 +38,8 @@ :display-xref-locations :display-xref-references :find-root-directory - :buffer-root-directory) + :buffer-root-directory + :set-region-point-global) #+sbcl (:lock t)) (in-package :lem/language-mode) @@ -153,7 +154,11 @@ (uncomment-region) (comment-region))) -(defun set-region-point (start end) +(defgeneric set-region-point-global (start end global-mode)) + +(defmethod set-region-point-global ((start point) (end point) + (global-mode lem-core::emacs-mode)) + (declare (ignore global-mode)) (cond ((buffer-mark-p (current-buffer)) (move-point start (cursor-region-beginning (current-point))) @@ -166,7 +171,7 @@ (alexandria:when-let ((line-comment (variable-value 'line-comment :buffer))) (with-point ((start (current-point)) (end (current-point))) - (set-region-point start end) + (set-region-point-global start end (lem-core::current-global-mode)) (loop (skip-whitespace-forward start) (when (point>= start end) @@ -183,7 +188,7 @@ (when line-comment (with-point ((start (current-point) :right-inserting) (end (current-point) :left-inserting)) - (set-region-point start end) + (set-region-point-global start end (lem-core::current-global-mode)) (skip-whitespace-forward start) (when (point>= start end) (insert-string (current-point) line-comment) @@ -210,7 +215,7 @@ (when line-comment (with-point ((start (current-point) :right-inserting) (end (current-point) :right-inserting)) - (set-region-point start end) + (set-region-point-global start end (lem-core::current-global-mode)) (let ((p start)) (loop (parse-partial-sexp p end nil t) diff --git a/src/internal-packages.lisp b/src/internal-packages.lisp index e7000295d..24b477ccb 100644 --- a/src/internal-packages.lisp +++ b/src/internal-packages.lisp @@ -23,6 +23,12 @@ :void-object :text-object)) +(defpackage :lem-generics + (:use :cl :lem-base) + (:export + :global-mode-region-beginning + :global-mode-region-end)) + (uiop:define-package :lem-core (:use :cl :lem/common/killring