Stacken/c64-livecoding
6
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Rewrite forward and backward commands, they now behave like Emacs's

Browse source
This commit is contained in:
John Lorentzson 2025-07-31 14:35:55 +02:00
parent 63a9b50fb4
commit fec79106d2
1 changed files with 48 additions and 40 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

88
editor/editor.lisp
View file

@ -787,51 +787,59 @@ Additionally ensures correct line numbers on the way, as a bonus."
(com-end-of-line)))) (com-end-of-line))))
(update-buffer-cursor buffer))) (update-buffer-cursor buffer)))
(defun word-boundary-p (char)
(not (alphanumericp char)))
(defun com-forward-word () (defun com-forward-word ()
(with-editor-accessors *editor* (:current-buffer buffer (with-editor-accessors *editor* (:current-buffer buffer
:current-line line :current-line cursor-line
:current-column column) :current-column cursor-column)
(loop :for char := (char (line-content line) column) (let ((found-word-p nil))
:do (incf column) (block :search
:when (>= column (line-length line)) (do-buffer (line column char :start-line cursor-line
:do (if (null (next-line line)) :start-column cursor-column)
(progn buffer
(feep) (cond ((and found-word-p (word-boundary-p char))
(return)) (setf cursor-line line
(setf column 0 cursor-column column)
line (next-line line))) (update-buffer-cursor buffer)
:until (or (zerop column) (return-from :search))
(null line) ((and (or found-word-p (alphanumericp char))
(char= char #\Space))) (= column (1- (line-length line))))
(update-buffer-cursor buffer))) (setf cursor-line line
cursor-column (1+ column))
(update-buffer-cursor buffer)
(return-from :search))
((alphanumericp char)
(setf found-word-p t))))
;; Failure case, nothing found
(feep)))))
(defun com-backward-word () (defun com-backward-word ()
(with-editor-accessors *editor* (:current-buffer buffer (with-editor-accessors *editor* (:current-buffer buffer
:current-line line :current-line cursor-line
:current-column column) :current-column cursor-column)
(when (zerop column) (let ((found-word-p nil))
(if (null (prev-line line)) (block :search
(progn (do-buffer (line column char :start-line cursor-line
(feep) :start-column (1- cursor-column)
(return-from com-backward-word)) :direction :backward)
(setf line (prev-line line) buffer
column (line-length line)))) (cond ((and found-word-p (word-boundary-p char))
(loop :with donep := nil (setf cursor-line line
:do (decf column) cursor-column (1+ column))
:when (minusp column) (update-buffer-cursor buffer)
:do (if (null (prev-line line)) (return-from :search))
(progn ((and (or found-word-p (alphanumericp char))
(feep) (zerop column))
(setf column 0) (setf cursor-line line
(return)) cursor-column column)
(setf column (1- (line-length line)) (update-buffer-cursor buffer)
line (prev-line line) (return-from :search))
donep t)) ((alphanumericp char)
:until (or donep (setf found-word-p t))))
(zerop column) ;; Failure case, nothing found
(null line) (feep)))))
(char= (char (line-content line) (1- column)) #\Space)))
(update-buffer-cursor buffer)))
(defun com-next-page () (defun com-next-page ()
(with-editor-accessors *editor* (:current-line line (with-editor-accessors *editor* (:current-line line