Skip to content

Commit 7d5b899

Browse files
committed
refactor
1 parent bd55a63 commit 7d5b899

2 files changed

Lines changed: 51 additions & 81 deletions

File tree

src/buffer/internal/buffer-insert.lisp

Lines changed: 9 additions & 32 deletions
Original file line numberDiff line numberDiff line change
@@ -118,26 +118,6 @@
118118
(setf start (1+ pos))))))))
119119
string))
120120

121-
(defun %delete-line-between/point (point start end line killring-stream)
122-
(line:line-property-delete-pos (point-line point)
123-
(point-charpos point)
124-
(- end start))
125-
(write-string (line:line-substring line :start start :end end) killring-stream)
126-
(line:delete-region line :start start :end end))
127-
128-
(defun %delete-line-eol/point (point start line killring-stream)
129-
(line:line-property-delete-line (point-line point) (point-charpos point))
130-
(write-string (line:line-substring line :start start) killring-stream)
131-
(line:delete-region line :start start))
132-
133-
(defun %delete-line/point (point start line killring-stream remaining-deletions)
134-
(line:line-property-delete-line (point-line point) (point-charpos point))
135-
(write-line (line:line-substring line :start start) killring-stream)
136-
(decf remaining-deletions (1+ (- (line:line-length line) start)))
137-
(decf (buffer-nlines (point-buffer point)))
138-
(line:merge-with-next-line (point-line point) :start start)
139-
remaining-deletions)
140-
141121
(defgeneric delete-char/point (point remaining-deletions)
142122
(:method (point remaining-deletions)
143123
(with-modify-buffer (point remaining-deletions)
@@ -149,26 +129,23 @@
149129
:for eolp := (> remaining-deletions (- (line:line-length line) charpos))
150130
:do (cond
151131
((not eolp)
152-
(%delete-line-between/point point
153-
charpos
154-
(+ charpos remaining-deletions)
155-
line
156-
killring-stream)
132+
(let ((end (+ charpos remaining-deletions)))
133+
(write-string (line:line-substring line :start charpos :end end) killring-stream)
134+
(line:delete-region line :start charpos :end end))
157135
(shift-markers point
158136
offset-line
159137
(- remaining-deletions))
160138
(return))
161139
((null (line:line-next line))
162-
(%delete-line-eol/point point charpos line killring-stream)
140+
(write-string (line:line-substring line :start charpos) killring-stream)
141+
(line:delete-region line :start charpos)
163142
(shift-markers point offset-line (- charpos (line:line-length line)))
164143
(return))
165144
(t
166-
(setf remaining-deletions
167-
(%delete-line/point point
168-
charpos
169-
line
170-
killring-stream
171-
remaining-deletions))))
145+
(decf (buffer-nlines (point-buffer point)))
146+
(decf remaining-deletions (1+ (- (line:line-length line) charpos)))
147+
(write-line (line:line-substring line :start charpos) killring-stream)
148+
(line:merge-with-next-line line :start charpos)))
172149
(decf offset-line)
173150
:finally (shift-markers point offset-line 0)))))))
174151

src/buffer/line.lisp

Lines changed: 42 additions & 49 deletions
Original file line numberDiff line numberDiff line change
@@ -30,8 +30,7 @@
3030
:line-search-property
3131
:line-search-property-range
3232
:line-property-insert-pos
33-
:line-property-delete-pos
34-
:line-property-delete-line
33+
:line-delete-property-region
3534
:line-string/attributes
3635
:line-substring
3736
:insert-string
@@ -53,10 +52,11 @@
5352
:initarg :next
5453
:initform nil
5554
:accessor line-next)
56-
(str
57-
:initarg :str
55+
(string
56+
:initarg :string
5857
:initform nil
59-
:accessor line-string)
58+
:reader line-string
59+
:writer set-line-string)
6060
(plist
6161
:initarg :plist
6262
:initform nil
@@ -76,11 +76,11 @@
7676
(line-string object)
7777
(line-plist object))))
7878

79-
(defun make-line (previous next str)
79+
(defun make-line (previous next string)
8080
(let ((line (make-instance 'line
8181
:next next
8282
:previous previous
83-
:str str)))
83+
:string string)))
8484
(when next
8585
(setf (line-previous next) line))
8686
(when previous
@@ -97,10 +97,10 @@
9797
(when (line-next line)
9898
(setf (line-previous (line-next line))
9999
(line-previous line)))
100-
(setf (line-previous line) nil
101-
(line-next line) nil
102-
(line-string line) nil
103-
(line-points line) nil))
100+
(setf (line-previous line) nil)
101+
(setf (line-next line) nil)
102+
(setf (line-points line) nil)
103+
(set-line-string nil line))
104104

105105
(defun line-alive-p (line)
106106
(not (null (line-string line))))
@@ -265,43 +265,34 @@
265265
(setf (getf new-plist (car plist-rest)) new-values))))
266266
(setf (line-plist next-line) new-plist)))
267267

268-
(defun line-property-delete-pos (line pos n)
268+
(defun line-delete-property-region (line start &optional end)
269+
(unless end (setf end (line-length line)))
270+
(assert (<= start end))
269271
(loop :for plist-rest :on (line-plist line) :by #'cddr
270272
:do (setf (cadr plist-rest)
271273
(loop :for elt :in (cadr plist-rest)
272-
:for (start end value) := elt
274+
:for (start1 end1 value) := elt
273275

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

277-
:else :if (<= pos (+ pos n) start)
278-
:collect (list (- start n) (- end n) value)
279+
:else :if (<= start end start1)
280+
:collect (list (- start1 (- end start))
281+
(- end1 (- end start))
282+
value)
279283

280-
:else :if (< pos start (+ pos n))
281-
:collect (list pos (- end n) value)
284+
:else :if (< start start1 end)
285+
:collect (list start (- end1 (- end start)) value)
282286

283-
:else :if (<= start pos (+ pos n) end)
284-
:collect (list start (- end n) value)
287+
:else :if (<= start1 start end end1)
288+
:collect (list start1 (- end1 (- end start)) value)
285289

286-
:else :if (<= start pos end (+ pos n))
287-
:collect (list start pos value)
290+
:else :if (<= start1 start end1 end)
291+
:collect (list start1 start value)
288292

289293
:else
290294
:collect elt))))
291295

292-
(defun line-property-delete-line (line pos)
293-
(loop :for plist-rest :on (line-plist line) :by #'cddr
294-
:do (setf (cadr plist-rest)
295-
(loop :for elt :in (cadr plist-rest)
296-
:for (start end value) := elt
297-
:if (<= pos start)
298-
:do (progn)
299-
:else :if (<= pos end)
300-
:collect (list start pos value)
301-
:else
302-
:collect elt
303-
))))
304-
305296
(defun line-string/attributes (line)
306297
(cons (line-string line)
307298
(alexandria:if-let (sticky-attribute (getf (line-plist line) :sticky-attribute))
@@ -319,30 +310,32 @@
319310

320311
(defun insert-string (line string index)
321312
(line-property-insert-pos line index (length string))
322-
(setf (line-string line)
323-
(concatenate 'string
324-
(line-substring line :start 0 :end index)
325-
string
326-
(line-substring line :start index))))
313+
(set-line-string (concatenate 'string
314+
(line-substring line :start 0 :end index)
315+
string
316+
(line-substring line :start index))
317+
line))
327318

328319
(defun insert-newline (line position)
329320
(let ((before-string (line-substring line :start 0 :end position))
330321
(after-string (line-substring line :start position)))
331-
(setf (line-string line) before-string)
322+
(set-line-string before-string line)
332323
(let ((next (make-line line (line-next line) after-string)))
333324
(line-property-insert-newline line next position))))
334325

335326
(defun delete-region (line &key start end)
336-
(setf (line-string line)
337-
(concatenate 'string
338-
(line-substring line :start 0 :end start)
339-
(line-substring line :start (or end (line-length line))))))
327+
(line-delete-property-region line start end)
328+
(set-line-string (concatenate 'string
329+
(line-substring line :start 0 :end start)
330+
(line-substring line :start (or end (line-length line))))
331+
line))
340332

341333
(defun merge-with-next-line (line &key (start 0))
342334
(assert (line-next line))
335+
(line-delete-property-region line start)
343336
(line-merge line (line-next line) start)
344-
(setf (line-string line)
345-
(concatenate 'string
346-
(line-substring line :start 0 :end start)
347-
(line-string (line-next line))))
337+
(set-line-string (concatenate 'string
338+
(line-substring line :start 0 :end start)
339+
(line-string (line-next line)))
340+
line)
348341
(line-free (line-next line)))

0 commit comments

Comments
 (0)