[climacs-cvs] CVS update: climacs/base.lisp climacs/gui.lisp climacs/syntax.lisp
Robert Strandh
rstrandh at common-lisp.net
Mon Dec 27 11:32:48 UTC 2004
Update of /project/climacs/cvsroot/climacs
In directory common-lisp.net:/tmp/cvs-serv11024
Modified Files:
base.lisp gui.lisp syntax.lisp
Log Message:
performance improvements.
Date: Mon Dec 27 12:32:46 2004
Author: rstrandh
Index: climacs/base.lisp
diff -u climacs/base.lisp:1.5 climacs/base.lisp:1.6
--- climacs/base.lisp:1.5 Sun Dec 26 08:18:01 2004
+++ climacs/base.lisp Mon Dec 27 12:32:46 2004
@@ -66,14 +66,12 @@
(end-of-line mark)
(delete-region offset mark))))
-(defun buffer-number-of-lines-in-region (mark1 mark2)
- "Helper function for number-of-lines-in-region. Moves the position
-of mark1 until it is greater than or equal to that of mark2 and counts
-Newline characters along the way"
- (loop do (end-of-line mark1)
- while (mark< mark1 mark2)
- count t
- do (incf (offset mark1))))
+(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"
+ (loop while (< offset1 offset2)
+ count (eql (buffer-object buffer offset1) #\Newline)
+ do (incf offset1)))
(defgeneric number-of-lines-in-region (mark1 mark2)
(:documentation "Return the number of lines (or rather the number of
@@ -81,21 +79,13 @@
acceptable to pass an offset in place of one of the marks"))
(defmethod number-of-lines-in-region ((mark1 mark) (mark2 mark))
- (buffer-number-of-lines-in-region (clone-mark mark1) mark2))
+ (buffer-number-of-lines-in-region (buffer mark1) (offset mark1) (offset mark2)))
(defmethod number-of-lines-in-region ((offset integer) (mark mark))
- (buffer-number-of-lines-in-region
- (make-instance 'standard-left-sticky-mark
- :buffer (buffer mark)
- :offset offset)
- mark))
+ (buffer-number-of-lines-in-region (buffer mark) offset (offset mark)))
(defmethod number-of-lines-in-region ((mark mark) (offset integer))
- (buffer-number-of-lines-in-region
- (clone-mark mark)
- (make-instance 'standard-left-sticky-mark
- :buffer (buffer mark)
- :offset offset)))
+ (buffer-number-of-lines-in-region (buffer mark) (offset mark) offset))
(defun constituentp (obj)
"A predicate to ensure that an object is a constituent character."
Index: climacs/gui.lisp
diff -u climacs/gui.lisp:1.19 climacs/gui.lisp:1.20
--- climacs/gui.lisp:1.19 Mon Dec 27 06:58:29 2004
+++ climacs/gui.lisp Mon Dec 27 12:32:46 2004
@@ -48,6 +48,7 @@
(win (make-pane 'climacs-pane
:width 900 :height 400
:name 'win
+;;; :incremental-redisplay t
:display-function 'display-win))
(int :interactor :width 900 :height 50 :max-height 50))
(:layouts
@@ -114,7 +115,7 @@
(format *error-output* "~a~%" condition)))
(setf gestures '()))
(t nil))))
- (redisplay-frame-panes frame :force-p t))))
+ (redisplay-frame-panes frame))))
(define-command com-quit ()
(frame-exit *application-frame*))
Index: climacs/syntax.lisp
diff -u climacs/syntax.lisp:1.7 climacs/syntax.lisp:1.8
--- climacs/syntax.lisp:1.7 Mon Dec 27 05:32:44 2004
+++ climacs/syntax.lisp Mon Dec 27 12:32:46 2004
@@ -49,8 +49,7 @@
(let ((buffer (buffer pane)))
(with-slots (top bot scan space-width tab-width) syntax
(setf top (make-instance 'standard-left-sticky-mark :buffer buffer)
- bot (make-instance 'standard-right-sticky-mark :buffer buffer)
- scan (make-instance 'standard-left-sticky-mark :buffer buffer))
+ bot (make-instance 'standard-right-sticky-mark :buffer buffer))
(let* ((medium (sheet-medium pane))
(style (medium-text-style medium)))
(setf space-width (text-style-width style medium)
@@ -67,27 +66,39 @@
'string)
:stream pane)))
+(defmacro maybe-updating-output (stuff &body body)
+ `(progn , at body))
+
+;; (defmacro maybe-updating-output (stuff &body body)
+;; `(updating-output ,stuff , at body))
+
(defmethod display-line (pane (syntax basic-syntax))
(with-slots (saved-offset bot scan cursor-x cursor-y space-width tab-width) syntax
(flet ((compute-contents ()
(unless (null saved-offset)
- (prog1 (coerce (region-to-sequence saved-offset scan) 'string)
+ (prog1 (coerce (buffer-sequence (buffer pane) saved-offset scan) 'string)
(setf saved-offset nil)))))
(macrolet ((output-word (&body body)
`(let ((contents (compute-contents)))
- (present-contents contents pane syntax)
- , at body)))
- (loop when (mark= scan (point pane))
+ (if (null contents)
+ (progn , at body)
+ (maybe-updating-output (pane :unique-id (incf id)
+ :cache-value contents
+ :cache-test #'string=)
+ (present-contents contents pane syntax)
+ , at body)))))
+ (loop with id = 0
+ when (mark= scan (point pane))
do (multiple-value-bind (x y) (stream-cursor-position pane)
(setf cursor-x (+ x (if (null saved-offset)
0
- (* space-width (- (offset scan) saved-offset))))
+ (* space-width (- scan saved-offset))))
cursor-y y))
when (mark= scan bot)
do (output-word)
(return)
- until (eql (object-after scan) #\Newline)
- do (let ((obj (object-after scan)))
+ until (eql (buffer-object (buffer pane) scan) #\Newline)
+ do (let ((obj (buffer-object (buffer pane) scan)))
(cond ((eql obj #\Space)
(output-word (princ obj pane)))
((eql obj #\Tab)
@@ -97,13 +108,12 @@
pane (- tab-width (mod x tab-width)) 0)))
((constituentp obj)
(when (null saved-offset)
- (setf saved-offset (offset scan))))
+ (setf saved-offset scan)))
(t
(output-word (princ obj pane)))))
- (incf (offset scan))
- finally (output-word)
- (incf (offset scan))
- (terpri pane))))))
+ (incf scan)
+ finally (output-word (terpri pane))
+ (incf scan))))))
(defmethod redisplay-with-syntax (pane (syntax basic-syntax))
(let* ((medium (sheet-medium pane))
@@ -138,9 +148,11 @@
until (end-of-buffer-p bot)
do (incf (offset bot))
(end-of-line bot)))
- (setf (offset scan) (offset top))
- (loop until (mark= scan bot)
- do (display-line pane syntax))
+ (setf scan (offset top))
+ (loop for id from 0
+ until (mark= scan bot)
+ do (maybe-updating-output (pane :unique-id id)
+ (display-line pane syntax)))
(when (mark= scan (point pane))
(multiple-value-bind (x y) (stream-cursor-position pane)
(setf cursor-x x
More information about the Climacs-cvs
mailing list