[climacs-cvs] CVS update: climacs/TODO climacs/base-test.lisp climacs/base.lisp climacs/buffer-test.lisp climacs/cl-syntax.lisp climacs/climacs.asd climacs/html-syntax.lisp climacs/packages.lisp climacs/pane.lisp climacs/text-syntax.lisp
Aleksandar Bakic
abakic at common-lisp.net
Sun Mar 13 20:51:53 UTC 2005
Update of /project/climacs/cvsroot/climacs
In directory common-lisp.net:/tmp/cvs-serv22428
Modified Files:
TODO base-test.lisp base.lisp buffer-test.lisp cl-syntax.lisp
climacs.asd html-syntax.lisp packages.lisp pane.lisp
text-syntax.lisp
Log Message:
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.
Date: Sun Mar 13 21:51:48 2005
Author: abakic
Index: climacs/TODO
diff -u climacs/TODO:1.5 climacs/TODO:1.6
--- climacs/TODO:1.5 Sun Feb 20 06:39:15 2005
+++ climacs/TODO Sun Mar 13 21:51:48 2005
@@ -1,8 +1,6 @@
- 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
Index: climacs/base-test.lisp
diff -u climacs/base-test.lisp:1.12 climacs/base-test.lisp:1.13
--- climacs/base-test.lisp:1.12 Sun Feb 27 19:52:00 2005
+++ climacs/base-test.lisp Sun Mar 13 21:51:48 2005
@@ -350,16 +350,18 @@
(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)))
Index: climacs/base.lisp
diff -u climacs/base.lisp:1.37 climacs/base.lisp:1.38
--- climacs/base.lisp:1.37 Sat Feb 19 07:19:06 2005
+++ climacs/base.lisp Sun Mar 13 21:51:48 2005
@@ -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 , at 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 @@
(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 @@
(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 @@
(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 @@
(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"
Index: climacs/buffer-test.lisp
diff -u climacs/buffer-test.lisp:1.18 climacs/buffer-test.lisp:1.19
--- climacs/buffer-test.lisp:1.18 Sun Feb 27 19:52:01 2005
+++ climacs/buffer-test.lisp Sun Mar 13 21:51:48 2005
@@ -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 @@
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
Index: climacs/cl-syntax.lisp
diff -u climacs/cl-syntax.lisp:1.5 climacs/cl-syntax.lisp:1.6
--- climacs/cl-syntax.lisp:1.5 Wed Mar 2 04:59:03 2005
+++ climacs/cl-syntax.lisp Sun Mar 13 21:51:48 2005
@@ -166,9 +166,8 @@
(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 @@
(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)
Index: climacs/climacs.asd
diff -u climacs/climacs.asd:1.23 climacs/climacs.asd:1.24
--- climacs/climacs.asd:1.23 Fri Mar 11 11:23:33 2005
+++ climacs/climacs.asd Sun Mar 13 21:51:48 2005
@@ -46,6 +46,7 @@
"Persistent/binseq-package"
"Persistent/binseq"
"Persistent/obinseq"
+ "Persistent/binseq2"
"translate"
"packages"
"buffer"
Index: climacs/html-syntax.lisp
diff -u climacs/html-syntax.lisp:1.11 climacs/html-syntax.lisp:1.12
--- climacs/html-syntax.lisp:1.11 Sun Mar 13 07:55:27 2005
+++ climacs/html-syntax.lisp Sun Mar 13 21:51:48 2005
@@ -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 @@
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)
Index: climacs/packages.lisp
diff -u climacs/packages.lisp:1.55 climacs/packages.lisp:1.56
--- climacs/packages.lisp:1.55 Thu Mar 10 07:37:40 2005
+++ climacs/packages.lisp Sun Mar 13 21:51:48 2005
@@ -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))
Index: climacs/pane.lisp
diff -u climacs/pane.lisp:1.20 climacs/pane.lisp:1.21
--- climacs/pane.lisp:1.20 Sat Mar 5 08:03:53 2005
+++ climacs/pane.lisp Sun Mar 13 21:51:48 2005
@@ -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)
Index: climacs/text-syntax.lisp
diff -u climacs/text-syntax.lisp:1.5 climacs/text-syntax.lisp:1.6
--- climacs/text-syntax.lisp:1.5 Tue Jan 18 00:10:24 2005
+++ climacs/text-syntax.lisp Sun Mar 13 21:51:48 2005
@@ -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)))))))
More information about the Climacs-cvs
mailing list