Commit 94f6939a authored by Aleksandar Bakic's avatar Aleksandar Bakic

Line-oriented persistent buffer (binseq2). Warning: Need to fix minor

bugs (related to number-of-lines-in-region, I believe).

base.lisp: Added faster methods on previous-line, next-line,
buffer-number-of-lines-in-region.

pane.lisp, cl-syntax.lisp, html-syntax.lisp, text-syntax.lisp:
Replaced some calls to make-instance to calls to clone-mark and (setf
offset), in order to avoid passing climacs-buffer to marks. This also
made possible to get rid of delegating methods on syntax.

climacs.asd: Added Persistent/binseq2.

packages.lisp: Added binseq2-related symbols.

Persistent/binseq.lisp, Persistent/obinseq.lisp: Cleanup.

Persistent/persistent-buffer.lisp: Added code for binseq2-buffer and
related marks. Also some minor fixes.
parent 7cd27061
......@@ -59,4 +59,36 @@
#:obinseq-insert
#:obinseq-insert*
#:obinseq-remove
#:obinseq-remove*))
\ No newline at end of file
#:obinseq-remove*
#:binseq2-p
#:list-binseq2
#:binseq2-list
#:vector-binseq2
#:binseq2-vector
#:binseq2-empty
#:binseq2-length
#:binseq2-size
#:binseq2-front
#:binseq2-offset
#:binseq2-back
#:binseq2-front2
#:binseq2-line2
#:binseq2-back2
#:binseq2-get
#:binseq2-set
#:binseq2-get2
#:binseq2-set2
#:binseq2-sub
#:binseq2-sub2
#:binseq2-cons
#:binseq2-snoc
#:binseq2-append
#:binseq2-insert
#:binseq2-insert2
#:binseq2-insert*
#:binseq2-insert*2
#:binseq2-remove
#:binseq2-remove2
#:binseq2-remove*
#:binseq2-remove*2))
\ No newline at end of file
......@@ -22,7 +22,7 @@
(in-package :binseq)
(defun binseq-p (s)
(defun binseq-p (s) ; NOTE: should use a 3-vector instead of the 3-list...
(or (eq s 'empty)
(and (consp s)
(or (eq (car s) 'leaf)
......@@ -160,21 +160,19 @@
(cond
((<= i 0) 'empty)
((<= (binseq-length s) i) s)
(t (cond
((<= i (binseq-length (caddr s))) (binseq-front (caddr s) i))
(t (binseq-append
(caddr s)
(binseq-front (cdddr s) (- i (binseq-length (caddr s))))))))))
((<= i (binseq-length (caddr s))) (binseq-front (caddr s) i))
(t (binseq-append
(caddr s)
(binseq-front (cdddr s) (- i (binseq-length (caddr s))))))))
(defun binseq-back (s i)
(cond
((<= i 0) 'empty)
((<= (binseq-length s) i) s)
(t (cond
((<= i (binseq-length (cdddr s))) (binseq-back (cdddr s) i))
(t (binseq-append
(binseq-back (caddr s) (- i (binseq-length (cdddr s))))
(cdddr s)))))))
((<= i (binseq-length (cdddr s))) (binseq-back (cdddr s) i))
(t (binseq-append
(binseq-back (caddr s) (- i (binseq-length (cdddr s))))
(cdddr s)))))
(defun %has-index (s i)
(and (<= 0 i) (< i (binseq-length s))))
......
This diff is collapsed.
......@@ -28,7 +28,7 @@
(or (null s)
(atom s)
(and (consp s)
(and (integerp (car s))
(and (integerp (car s)) ; might wanna check the value
(consp (cdr s))
(obinseq-p (cadr s))
(obinseq-p (cddr s))))))
......@@ -167,21 +167,19 @@
(cond
((<= i 0) nil)
((<= (obinseq-length s) i) s)
(t (cond
((<= i (obinseq-length (cadr s))) (obinseq-front (cadr s) i))
(t (obinseq-append
(cadr s)
(obinseq-front (cddr s) (- i (obinseq-length (cadr s))))))))))
((<= i (obinseq-length (cadr s))) (obinseq-front (cadr s) i))
(t (obinseq-append
(cadr s)
(obinseq-front (cddr s) (- i (obinseq-length (cadr s))))))))
(defun obinseq-back (s i)
(cond
((<= i 0) nil)
((<= (obinseq-length s) i) s)
(t (cond
((<= i (obinseq-length (cddr s))) (obinseq-back (cddr s) i))
(t (obinseq-append
(obinseq-back (cadr s) (- i (obinseq-length (cddr s))))
(cddr s)))))))
((<= i (obinseq-length (cddr s))) (obinseq-back (cddr s) i))
(t (obinseq-append
(obinseq-back (cadr s) (- i (obinseq-length (cddr s))))
(cddr s)))))
(defun %ohas-index (s i)
(and (<= 0 i) (< i (obinseq-length s))))
......
This diff is collapsed.
- modify standard-buffer to use obinseq with leafs containing
flexichain-based lines
- implement a persistent buffer as a binseq of obinseqs (or similar,
one sequence type for lines, the other for line contents), then
upgrade it to an undoable buffer
- upgrade persistent buffer based on binseq2 to an undoable buffer
- replace the use of the scroller pane by custom pane
......@@ -350,16 +350,18 @@ b")
(let ((buffer (make-instance %%buffer)))
(insert-buffer-sequence buffer 0 "climacs
climacs")
(print (climacs-buffer::buffer-line-number buffer 15))
(values
(climacs-base::buffer-number-of-lines-in-region buffer 0 6)
(climacs-base::buffer-number-of-lines-in-region buffer 0 7)
(climacs-base::buffer-number-of-lines-in-region buffer 0 8)
(climacs-base::buffer-number-of-lines-in-region buffer 0 10)
(climacs-base::buffer-number-of-lines-in-region buffer 0 13)
(climacs-base::buffer-number-of-lines-in-region buffer 0 14)
(climacs-base::buffer-number-of-lines-in-region buffer 7 10)
(climacs-base::buffer-number-of-lines-in-region buffer 8 13)
(climacs-base::buffer-number-of-lines-in-region buffer 8 14)))
0 0 1 1 1 1 0 0)
0 0 1 1 1 1 1 0 0)
(defmultitest buffer-display-column.test-1
(let ((buffer (make-instance %%buffer)))
......
......@@ -36,13 +36,13 @@
&body body)
"Iterate over the elements of the region delimited by offset1 and offset2.
The body is executed for each element, with object being the current object
(setf-able), and offset being its offset."
\(setf-able), and offset being its offset."
`(symbol-macrolet ((,object (buffer-object ,buffer ,offset)))
(loop for ,offset from ,offset1 below ,offset2
do ,@body)))
(defun previous-line (mark &optional column (count 1))
"Move a mark up one line conserving horizontal position."
(defmethod previous-line (mark &optional column (count 1))
"Move a mark up COUNT lines conserving horizontal position."
(unless column
(setf column (column-number mark)))
(loop repeat count
......@@ -54,8 +54,17 @@ The body is executed for each element, with object being the current object
(beginning-of-line mark)
(incf (offset mark) column)))
(defun next-line (mark &optional column (count 1))
"Move a mark down one line conserving horizontal position."
(defmethod previous-line ((mark p-line-mark-mixin) &optional column (count 1))
"Move a mark up COUNT lines conserving horizontal position."
(unless column
(setf column (column-number mark)))
(let* ((line (line-number mark))
(goto-line (max 0 (- line count))))
(setf (offset mark)
(+ column (buffer-line-offset (buffer mark) goto-line)))))
(defmethod next-line (mark &optional column (count 1))
"Move a mark down COUNT lines conserving horizontal position."
(unless column
(setf column (column-number mark)))
(loop repeat count
......@@ -67,16 +76,26 @@ The body is executed for each element, with object being the current object
(beginning-of-line mark)
(incf (offset mark) column)))
(defmethod next-line ((mark p-line-mark-mixin) &optional column (count 1))
"Move a mark down COUNT lines conserving horizontal position."
(unless column
(setf column (column-number mark)))
(let* ((line (line-number mark))
(goto-line (min (number-of-lines (buffer mark))
(+ line count))))
(setf (offset mark)
(+ column (buffer-line-offset (buffer mark) goto-line)))))
(defmethod open-line ((mark left-sticky-mark) &optional (count 1))
"Create a new line in a buffer after the mark."
(loop repeat count
do (insert-object mark #\Newline)))
do (insert-object mark #\Newline)))
(defmethod open-line ((mark right-sticky-mark) &optional (count 1))
"Create a new line in a buffer after the mark."
(loop repeat count
do (insert-object mark #\Newline)
(decf (offset mark))))
do (insert-object mark #\Newline)
(decf (offset mark))))
(defun kill-line (mark)
"Remove a line from a buffer."
......@@ -105,13 +124,19 @@ constituent character of the line."
(incf (offset mark2))
finally (return indentation))))
(defun buffer-number-of-lines-in-region (buffer offset1 offset2)
"Helper function for number-of-lines-in-region. Count newline
characters in the region between offset1 and offset2"
(defmethod buffer-number-of-lines-in-region (buffer offset1 offset2)
"Helper method for number-of-lines-in-region. Count newline
characters in the region between offset1 and offset2."
(loop while (< offset1 offset2)
count (eql (buffer-object buffer offset1) #\Newline)
do (incf offset1)))
(defmethod buffer-number-of-lines-in-region
((buffer binseq2-buffer) offset1 offset2)
"Helper method for NUMBER-OF-LINES-IN-REGION."
(- (buffer-line-number buffer offset2)
(buffer-line-number buffer offset1)))
(defun buffer-display-column (buffer offset tab-width)
(let ((line-start-offset (- offset (buffer-column-number buffer offset))))
(loop with column = 0
......@@ -578,7 +603,7 @@ containing VECTOR or NIL if no such offset exists"
(loop for i downfrom (- offset (length vector)) to 0
when (buffer-looking-at buffer i vector :test test)
return i
finally (return nil)))
finally (return nil)))
(defun search-forward (mark vector &key (test #'eql))
"move MARK forward after the first occurence of VECTOR after MARK"
......
......@@ -48,6 +48,13 @@
''persistent-right-sticky-mark
(intern (concatenate 'string "OBINSEQ-BUFFER-" name-string))
form
results)
,(%deftest-wrapper
''binseq2-buffer
''persistent-left-sticky-line-mark
''persistent-right-sticky-line-mark
(intern (concatenate 'string "BINSEQ2-BUFFER-" name-string))
form
results)))))
(defmultitest buffer-make-instance.test-1
......@@ -966,3 +973,76 @@ climacs")
do (insert-buffer-sequence b (floor (size b) 2) "abcdefghij")
finally (return (size b))))
1000000)
(defmultitest performance.test-4
(time
(let ((b (make-instance %%buffer)))
(insert-buffer-sequence b 0 (make-array '(100000) :initial-element #\a))
(let ((m (clone-mark (low-mark b))))
(loop
for i from 0 below 1000
for f = t then (not b)
do (if f
(end-of-line m)
(beginning-of-line m))))))
nil)
(defmultitest performance.test-4b
(time
(let ((b (make-instance %%buffer)))
(insert-buffer-object b 0 #\Newline)
(insert-buffer-sequence b 0 (make-array '(100000) :initial-element #\a))
(insert-buffer-object b 0 #\Newline)
(let ((m (clone-mark (low-mark b))))
(loop
for i from 0 below 1000
for f = t then (not b)
do (if f
(end-of-line m)
(beginning-of-line m))))))
nil)
(defmultitest performance.test-4c
(time
(let ((b (make-instance %%buffer)))
(insert-buffer-object b 0 #\Newline)
(insert-buffer-sequence b 0 (make-array '(100000) :initial-element #\a))
(insert-buffer-object b 0 #\Newline)
(let ((m (clone-mark (low-mark b))))
(incf (offset m))
(loop
for i from 0 below 1000
for f = t then (not b)
do (if f
(end-of-line m)
(beginning-of-line m))))))
nil)
(defmultitest performance.test-4d
(time
(let ((b (make-instance %%buffer)))
(insert-buffer-object b 0 #\Newline)
(insert-buffer-sequence b 0 (make-array '(100000) :initial-element #\a))
(insert-buffer-object b 0 #\Newline)
(let ((m (clone-mark (low-mark b))))
(setf (offset m) (floor (size b) 2))
(loop
for i from 0 below 10
collect (list (line-number m) (column-number m))))))
((1 50000) (1 50000) (1 50000) (1 50000) (1 50000) (1 50000)
(1 50000) (1 50000) (1 50000) (1 50000)))
(defmultitest performance.test-4e
(time
(let ((b (make-instance %%buffer)))
(insert-buffer-sequence
b 0 (make-array '(100000) :initial-element #\Newline))
(let ((m (clone-mark (low-mark b))))
(loop
for i from 0 below 1000
for f = t then (not b)
do (if f
(next-line m 0 100000)
(previous-line m 0 100000))
finally (return (number-of-lines b))))))
100000)
\ No newline at end of file
......@@ -166,9 +166,8 @@ macro characters that start more complex expressions."))
(defmethod initialize-instance :after ((syntax cl-syntax) &rest args)
(declare (ignore args))
(with-slots (buffer elements) syntax
(let ((mark (make-instance 'standard-left-sticky-mark
:buffer buffer
:offset 0)))
(let ((mark (clone-mark (low-mark buffer) :left)))
(setf (offset mark) 0)
(insert* elements 0 (make-instance 'start-entry
:start-mark mark :size 0)))))
......@@ -257,11 +256,12 @@ macro characters that start more complex expressions."))
(loop until (or (= guess-pos (nb-elements elements))
(mark> (start-mark (element* elements guess-pos)) high-mark))
do (delete* elements guess-pos))
(setf scan (make-instance 'standard-left-sticky-mark
:buffer buffer
:offset (if (zerop guess-pos)
0
(end-offset (element* elements (1- guess-pos))))))
(let ((m (clone-mark (low-mark buffer) :left)))
(setf (offset m)
(if (zerop guess-pos)
0
(end-offset (element* elements (1- guess-pos)))))
(setf scan m))
;; scan
(loop with start-mark = nil
do (loop until (end-of-buffer-p scan)
......
......@@ -46,6 +46,7 @@
"Persistent/binseq-package"
"Persistent/binseq"
"Persistent/obinseq"
"Persistent/binseq2"
"translate"
"packages"
"buffer"
......
......@@ -276,12 +276,12 @@
(setf parser (make-instance 'parser
:grammar *html-grammar*
:target 'html))
(insert* lexemes 0 (make-instance 'start-element
:start-mark (make-instance 'standard-left-sticky-mark
:buffer buffer
:offset 0)
:size 0
:state (initial-state parser)))))
(let ((m (clone-mark (low-mark buffer) :left)))
(setf (offset m) 0)
(insert* lexemes 0 (make-instance 'start-element
:start-mark m
:size 0
:state (initial-state parser))))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
......@@ -325,9 +325,10 @@ position in LEXEMES"
do (forward-object scan)))
(defun update-lex (lexemes start-pos end)
(let ((scan (make-instance 'standard-left-sticky-mark
:buffer (buffer end) ; FIXME, eventually use the buffer of the lexer
:offset (end-offset (element* lexemes (1- start-pos))))))
(let ((scan (clone-mark (low-mark (buffer end)) :left)))
;; FIXME, eventually use the buffer of the lexer
(setf (offset scan)
(end-offset (element* lexemes (1- start-pos))))
(loop do (skip-inter-lexeme-objects lexemes scan)
until (if (end-of-buffer-p end)
(end-of-buffer-p scan)
......
......@@ -47,8 +47,10 @@
#:object-before #:object-after #:region-to-sequence
#:low-mark #:high-mark #:modified-p #:clear-modify
#:binseq-buffer #:obinseq-buffer
#:binseq-buffer #:obinseq-buffer #:binseq2-buffer
#:persistent-left-sticky-mark #:persistent-right-sticky-mark
#:persistent-left-sticky-line-mark #:persistent-right-sticky-line-mark
#:p-line-mark-mixin #:buffer-line-offset
#:delegating-buffer #:implementation))
......
......@@ -182,20 +182,10 @@
;(defgeneric indent-tabs-mode (climacs-buffer))
;;; syntax delegation
(defmethod update-syntax ((buffer delegating-buffer) syntax)
(update-syntax (implementation buffer) syntax))
(defmethod update-syntax-for-redisplay ((buffer delegating-buffer) syntax from to)
(update-syntax-for-redisplay (implementation buffer) syntax from to))
;;; buffers
(defclass extended-standard-buffer (standard-buffer undo-mixin abbrev-mixin) ()
(:documentation "Extensions accessible via marks."))
(defclass extended-obinseq-buffer (obinseq-buffer undo-mixin abbrev-mixin) ()
(defclass extended-binseq2-buffer (binseq2-buffer undo-mixin abbrev-mixin) ()
(:documentation "Extensions accessible via marks."))
(defclass climacs-buffer (delegating-buffer filename-mixin name-mixin)
......
......@@ -80,9 +80,9 @@
(and (eql (buffer-object buffer (1- offset)) #\Newline)
(or (= offset 1)
(eql (buffer-object buffer (- offset 2)) #\Newline)))))
(insert* paragraphs pos1
(make-instance 'standard-left-sticky-mark
:buffer buffer :offset offset))
(let ((m (clone-mark (low-mark buffer) :left)))
(setf (offset m) offset)
(insert* paragraphs pos1 m))
(incf pos1))
((and (plusp offset)
(not (eql (buffer-object buffer (1- offset)) #\Newline))
......@@ -90,9 +90,9 @@
(and (eql (buffer-object buffer offset) #\Newline)
(or (= offset (1- buffer-size))
(eql (buffer-object buffer (1+ offset)) #\Newline)))))
(insert* paragraphs pos1
(make-instance 'standard-right-sticky-mark
:buffer buffer :offset offset))
(let ((m (clone-mark (low-mark buffer) :right)))
(setf (offset m) offset)
(insert* paragraphs pos1 m))
(incf pos1))
(t nil)))))))
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment