Compare commits
5 commits
dc59319900
...
10e4cf8dc3
Author | SHA1 | Date | |
---|---|---|---|
10e4cf8dc3 | |||
e717f49afc | |||
2331d15e11 | |||
fa4fa088fe | |||
c6ba4228b3 |
2 changed files with 62 additions and 15 deletions
|
@ -318,7 +318,7 @@ serial connection the editor normally runs under.")
|
||||||
:start1 (1+ column))
|
:start1 (1+ column))
|
||||||
(setf (char (line-content line) column) character))))
|
(setf (char (line-content line) column) character))))
|
||||||
(when (line-in-view line (current-view *editor*))
|
(when (line-in-view line (current-view *editor*))
|
||||||
(redisplay-line line :start column)))
|
(redisplay-line line :start column :addingp t)))
|
||||||
|
|
||||||
(defmethod delete-character-in-line ((line line) column)
|
(defmethod delete-character-in-line ((line line) column)
|
||||||
(unless (< column (fill-pointer (line-content line)))
|
(unless (< column (fill-pointer (line-content line)))
|
||||||
|
@ -368,12 +368,12 @@ serial connection the editor normally runs under.")
|
||||||
(cursor-column (cursor *editor*)) start)
|
(cursor-column (cursor *editor*)) start)
|
||||||
(update-buffer-cursor (current-buffer *editor*))))))
|
(update-buffer-cursor (current-buffer *editor*))))))
|
||||||
|
|
||||||
(defmethod redisplay-line ((line line) &key (start 0))
|
(defmethod redisplay-line ((line line) &key (start 0) addingp)
|
||||||
;; TODO: save the cursor position
|
;; TODO: save the cursor position
|
||||||
(with-editor-accessors *editor* (:current-line current
|
(with-editor-accessors *editor* (:current-line current
|
||||||
:current-buffer buffer)
|
:current-buffer buffer)
|
||||||
(cond
|
(cond
|
||||||
((= start (1- (line-length line)))
|
((and addingp (= start (1- (line-length line))))
|
||||||
(let ((char-pos (1- (fill-pointer (line-content line)))))
|
(let ((char-pos (1- (fill-pointer (line-content line)))))
|
||||||
(move-cursor (view-line-number (buffer-view buffer) line) char-pos)
|
(move-cursor (view-line-number (buffer-view buffer) line) char-pos)
|
||||||
(write-char (aref (line-content line) char-pos) *eio*)
|
(write-char (aref (line-content line) char-pos) *eio*)
|
||||||
|
@ -580,10 +580,15 @@ Additionally ensures correct line numbers on the way, as a bonus."
|
||||||
(feep))))
|
(feep))))
|
||||||
|
|
||||||
(defun com-forward-delete ()
|
(defun com-forward-delete ()
|
||||||
;; TODO: Check for end of line
|
|
||||||
(with-editor-accessors *editor* (:current-column column
|
(with-editor-accessors *editor* (:current-column column
|
||||||
:current-line line)
|
:current-line line)
|
||||||
(delete-character-in-line line column)))
|
(cond ((and (= column (line-length line)) (null (next-line line)))
|
||||||
|
(feep))
|
||||||
|
((= column (line-length line))
|
||||||
|
(merge-lines line (next-line line)))
|
||||||
|
(t
|
||||||
|
(delete-character-in-line line column)
|
||||||
|
(redisplay-line line :start column)))))
|
||||||
|
|
||||||
(defun com-backward-delete ()
|
(defun com-backward-delete ()
|
||||||
(with-editor-accessors *editor* (:current-column column
|
(with-editor-accessors *editor* (:current-column column
|
||||||
|
@ -678,6 +683,52 @@ 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 com-forward-word ()
|
||||||
|
(with-editor-accessors *editor* (:current-buffer buffer
|
||||||
|
:current-line line
|
||||||
|
:current-column column)
|
||||||
|
(loop :for char := (char (line-content line) column)
|
||||||
|
:do (incf column)
|
||||||
|
:when (>= column (line-length line))
|
||||||
|
:do (if (null (next-line line))
|
||||||
|
(progn
|
||||||
|
(feep)
|
||||||
|
(return))
|
||||||
|
(setf column 0
|
||||||
|
line (next-line line)))
|
||||||
|
:until (or (zerop column)
|
||||||
|
(null line)
|
||||||
|
(char= char #\Space)))
|
||||||
|
(update-buffer-cursor buffer)))
|
||||||
|
|
||||||
|
(defun com-backward-word ()
|
||||||
|
(with-editor-accessors *editor* (:current-buffer buffer
|
||||||
|
:current-line line
|
||||||
|
:current-column column)
|
||||||
|
(when (zerop column)
|
||||||
|
(if (null (prev-line line))
|
||||||
|
(progn
|
||||||
|
(feep)
|
||||||
|
(return-from com-backward-word))
|
||||||
|
(setf line (prev-line line)
|
||||||
|
column (line-length line))))
|
||||||
|
(loop :with donep := nil
|
||||||
|
:do (decf column)
|
||||||
|
:when (minusp column)
|
||||||
|
:do (if (null (prev-line line))
|
||||||
|
(progn
|
||||||
|
(feep)
|
||||||
|
(setf column 0)
|
||||||
|
(return))
|
||||||
|
(setf column (1- (line-length line))
|
||||||
|
line (prev-line line)
|
||||||
|
donep t))
|
||||||
|
:until (or donep
|
||||||
|
(zerop column)
|
||||||
|
(null line)
|
||||||
|
(char= (char (line-content line) (1- column)) #\Space)))
|
||||||
|
(update-buffer-cursor buffer)))
|
||||||
|
|
||||||
(defun com-new-buffer ()
|
(defun com-new-buffer ()
|
||||||
(setf (current-buffer *editor*)
|
(setf (current-buffer *editor*)
|
||||||
(make-instance 'buffer))
|
(make-instance 'buffer))
|
||||||
|
@ -763,7 +814,9 @@ Additionally ensures correct line numbers on the way, as a bonus."
|
||||||
((:c . #\d) com-forward-delete)
|
((:c . #\d) com-forward-delete)
|
||||||
((:c . #\j) com-newline)
|
((:c . #\j) com-newline)
|
||||||
((:c . #\n) com-new-buffer)
|
((:c . #\n) com-new-buffer)
|
||||||
((:c . #\l) com-refresh-screen)))
|
((:c . #\l) com-refresh-screen)
|
||||||
|
((:m . #\f) com-forward-word)
|
||||||
|
((:m . #\b) com-backward-word)))
|
||||||
|
|
||||||
(defun key-command-dispatch (key)
|
(defun key-command-dispatch (key)
|
||||||
(when (numberp key)
|
(when (numberp key)
|
||||||
|
|
|
@ -184,8 +184,7 @@ is the responsibility of the pre-assembly compilation step."
|
||||||
:do (setf *last-instruction* :useless)
|
:do (setf *last-instruction* :useless)
|
||||||
:unless (eql (strategy (allocation-details arg)) :direct-to-argvec)
|
:unless (eql (strategy (allocation-details arg)) :direct-to-argvec)
|
||||||
:do (emit-lda (data-reference arg))
|
:do (emit-lda (data-reference arg))
|
||||||
(emit-sta (cons :address (+ arg-index +argvec-offset+)))
|
(emit-sta (cons :address (+ arg-index +argvec-offset+))))
|
||||||
(format t "~D. ~A~%" arg-index arg))
|
|
||||||
(emit-asm-instruction :opcode #x20 :operand (callee inst) :byte-length 3)
|
(emit-asm-instruction :opcode #x20 :operand (callee inst) :byte-length 3)
|
||||||
(emit-store-data (output inst)))
|
(emit-store-data (output inst)))
|
||||||
|
|
||||||
|
@ -312,13 +311,8 @@ is the responsibility of the pre-assembly compilation step."
|
||||||
:when (typep asm-obj 'asm-instruction)
|
:when (typep asm-obj 'asm-instruction)
|
||||||
:do (case (opcode asm-obj)
|
:do (case (opcode asm-obj)
|
||||||
((#x10 #x30 #x50 #x70 #x90 #xb0 #xd0 #xf0)
|
((#x10 #x30 #x50 #x70 #x90 #xb0 #xd0 #xf0)
|
||||||
;; Relative branches
|
;; Relative branches are all generated with hardcoded offsets
|
||||||
(when (typep (operand asm-obj) 'iblock)
|
(assert (typep (operand asm-obj) '(unsigned-byte 8))))
|
||||||
(resolve-iblock asm-obj))
|
|
||||||
;; - 2 is to offset for the branch instruction's length
|
|
||||||
(unless (typep (operand asm-obj) '(unsigned-byte 8))
|
|
||||||
(let* ((offset (- (address (operand asm-obj)) (address asm-obj) 2)))
|
|
||||||
(setf (operand asm-obj) (ldb (byte 8 0) (the (signed-byte 8) offset))))))
|
|
||||||
(t
|
(t
|
||||||
(when (typep (operand asm-obj) 'iblock)
|
(when (typep (operand asm-obj) 'iblock)
|
||||||
(resolve-iblock asm-obj))
|
(resolve-iblock asm-obj))
|
||||||
|
|
Loading…
Add table
Reference in a new issue