Skip to content

Commit

Permalink
refactor
Browse files Browse the repository at this point in the history
  • Loading branch information
cxxxr committed Jul 23, 2024
1 parent bd55a63 commit 7d5b899
Show file tree
Hide file tree
Showing 2 changed files with 51 additions and 81 deletions.
41 changes: 9 additions & 32 deletions src/buffer/internal/buffer-insert.lisp
Original file line number Diff line number Diff line change
Expand Up @@ -118,26 +118,6 @@
(setf start (1+ pos))))))))
string))

(defun %delete-line-between/point (point start end line killring-stream)
(line:line-property-delete-pos (point-line point)
(point-charpos point)
(- end start))
(write-string (line:line-substring line :start start :end end) killring-stream)
(line:delete-region line :start start :end end))

(defun %delete-line-eol/point (point start line killring-stream)
(line:line-property-delete-line (point-line point) (point-charpos point))
(write-string (line:line-substring line :start start) killring-stream)
(line:delete-region line :start start))

(defun %delete-line/point (point start line killring-stream remaining-deletions)
(line:line-property-delete-line (point-line point) (point-charpos point))
(write-line (line:line-substring line :start start) killring-stream)
(decf remaining-deletions (1+ (- (line:line-length line) start)))
(decf (buffer-nlines (point-buffer point)))
(line:merge-with-next-line (point-line point) :start start)
remaining-deletions)

(defgeneric delete-char/point (point remaining-deletions)
(:method (point remaining-deletions)
(with-modify-buffer (point remaining-deletions)
Expand All @@ -149,26 +129,23 @@
:for eolp := (> remaining-deletions (- (line:line-length line) charpos))
:do (cond
((not eolp)
(%delete-line-between/point point
charpos
(+ charpos remaining-deletions)
line
killring-stream)
(let ((end (+ charpos remaining-deletions)))
(write-string (line:line-substring line :start charpos :end end) killring-stream)
(line:delete-region line :start charpos :end end))
(shift-markers point
offset-line
(- remaining-deletions))
(return))
((null (line:line-next line))
(%delete-line-eol/point point charpos line killring-stream)
(write-string (line:line-substring line :start charpos) killring-stream)
(line:delete-region line :start charpos)
(shift-markers point offset-line (- charpos (line:line-length line)))
(return))
(t
(setf remaining-deletions
(%delete-line/point point
charpos
line
killring-stream
remaining-deletions))))
(decf (buffer-nlines (point-buffer point)))
(decf remaining-deletions (1+ (- (line:line-length line) charpos)))
(write-line (line:line-substring line :start charpos) killring-stream)
(line:merge-with-next-line line :start charpos)))
(decf offset-line)
:finally (shift-markers point offset-line 0)))))))

Expand Down
91 changes: 42 additions & 49 deletions src/buffer/line.lisp
Original file line number Diff line number Diff line change
Expand Up @@ -30,8 +30,7 @@
:line-search-property
:line-search-property-range
:line-property-insert-pos
:line-property-delete-pos
:line-property-delete-line
:line-delete-property-region
:line-string/attributes
:line-substring
:insert-string
Expand All @@ -53,10 +52,11 @@
:initarg :next
:initform nil
:accessor line-next)
(str
:initarg :str
(string
:initarg :string
:initform nil
:accessor line-string)
:reader line-string
:writer set-line-string)
(plist
:initarg :plist
:initform nil
Expand All @@ -76,11 +76,11 @@
(line-string object)
(line-plist object))))

(defun make-line (previous next str)
(defun make-line (previous next string)
(let ((line (make-instance 'line
:next next
:previous previous
:str str)))
:string string)))
(when next
(setf (line-previous next) line))
(when previous
Expand All @@ -97,10 +97,10 @@
(when (line-next line)
(setf (line-previous (line-next line))
(line-previous line)))
(setf (line-previous line) nil
(line-next line) nil
(line-string line) nil
(line-points line) nil))
(setf (line-previous line) nil)
(setf (line-next line) nil)
(setf (line-points line) nil)
(set-line-string nil line))

(defun line-alive-p (line)
(not (null (line-string line))))
Expand Down Expand Up @@ -265,43 +265,34 @@
(setf (getf new-plist (car plist-rest)) new-values))))
(setf (line-plist next-line) new-plist)))

(defun line-property-delete-pos (line pos n)
(defun line-delete-property-region (line start &optional end)
(unless end (setf end (line-length line)))
(assert (<= start end))
(loop :for plist-rest :on (line-plist line) :by #'cddr
:do (setf (cadr plist-rest)
(loop :for elt :in (cadr plist-rest)
:for (start end value) := elt
:for (start1 end1 value) := elt

:if (<= pos start end (+ pos n -1))
:if (<= start start1 end1 (1- end))
:do (progn)

:else :if (<= pos (+ pos n) start)
:collect (list (- start n) (- end n) value)
:else :if (<= start end start1)
:collect (list (- start1 (- end start))
(- end1 (- end start))
value)

:else :if (< pos start (+ pos n))
:collect (list pos (- end n) value)
:else :if (< start start1 end)
:collect (list start (- end1 (- end start)) value)

:else :if (<= start pos (+ pos n) end)
:collect (list start (- end n) value)
:else :if (<= start1 start end end1)
:collect (list start1 (- end1 (- end start)) value)

:else :if (<= start pos end (+ pos n))
:collect (list start pos value)
:else :if (<= start1 start end1 end)
:collect (list start1 start value)

:else
:collect elt))))

(defun line-property-delete-line (line pos)
(loop :for plist-rest :on (line-plist line) :by #'cddr
:do (setf (cadr plist-rest)
(loop :for elt :in (cadr plist-rest)
:for (start end value) := elt
:if (<= pos start)
:do (progn)
:else :if (<= pos end)
:collect (list start pos value)
:else
:collect elt
))))

(defun line-string/attributes (line)
(cons (line-string line)
(alexandria:if-let (sticky-attribute (getf (line-plist line) :sticky-attribute))
Expand All @@ -319,30 +310,32 @@

(defun insert-string (line string index)
(line-property-insert-pos line index (length string))
(setf (line-string line)
(concatenate 'string
(line-substring line :start 0 :end index)
string
(line-substring line :start index))))
(set-line-string (concatenate 'string
(line-substring line :start 0 :end index)
string
(line-substring line :start index))
line))

(defun insert-newline (line position)
(let ((before-string (line-substring line :start 0 :end position))
(after-string (line-substring line :start position)))
(setf (line-string line) before-string)
(set-line-string before-string line)
(let ((next (make-line line (line-next line) after-string)))
(line-property-insert-newline line next position))))

(defun delete-region (line &key start end)
(setf (line-string line)
(concatenate 'string
(line-substring line :start 0 :end start)
(line-substring line :start (or end (line-length line))))))
(line-delete-property-region line start end)
(set-line-string (concatenate 'string
(line-substring line :start 0 :end start)
(line-substring line :start (or end (line-length line))))
line))

(defun merge-with-next-line (line &key (start 0))
(assert (line-next line))
(line-delete-property-region line start)
(line-merge line (line-next line) start)
(setf (line-string line)
(concatenate 'string
(line-substring line :start 0 :end start)
(line-string (line-next line))))
(set-line-string (concatenate 'string
(line-substring line :start 0 :end start)
(line-string (line-next line)))
line)
(line-free (line-next line)))

0 comments on commit 7d5b899

Please sign in to comment.