Update of /project/climacs/cvsroot/climacs In directory common-lisp.net:/tmp/cvs-serv29333
Modified Files: base.lisp buffer.lisp gui.lisp packages.lisp syntax.lisp Log Message: Moved forward-object and backward-object to base.lisp because I needed them in syntax.lisp.
Improved performance of end-of-line, the slowness of which was a problem for redisplay.
Fixed (I hope) bug in redisplay code. I don't seem to be able to convince McCLIM to avoid redrawing all the lines after a new line has been inserted, though.
Date: Sun Jan 9 12:54:50 2005 Author: rstrandh
Index: climacs/base.lisp diff -u climacs/base.lisp:1.12 climacs/base.lisp:1.13 --- climacs/base.lisp:1.12 Fri Jan 7 08:26:23 2005 +++ climacs/base.lisp Sun Jan 9 12:54:50 2005 @@ -28,6 +28,16 @@
(in-package :climacs-base)
+(defgeneric backward-object (mark &optional count)) +(defmethod backward-object ((mark climacs-buffer::mark-mixin) + &optional (count 1)) + (decf (offset mark) count)) + +(defgeneric forward-object (mark &optional count)) +(defmethod forward-object ((mark climacs-buffer::mark-mixin) + &optional (count 1)) + (incf (offset mark) count)) + (defun previous-line (mark &optional column) "Move a mark up one line conserving horizontal position." (unless column
Index: climacs/buffer.lisp diff -u climacs/buffer.lisp:1.16 climacs/buffer.lisp:1.17 --- climacs/buffer.lisp:1.16 Wed Jan 5 22:39:23 2005 +++ climacs/buffer.lisp Sun Jan 9 12:54:50 2005 @@ -288,8 +288,14 @@ at the end of the buffer if no following newline character exists."))
(defmethod end-of-line ((mark mark-mixin)) - (loop until (end-of-line-p mark) - do (incf (offset mark)))) + (let* ((offset (offset mark)) + (buffer (buffer mark)) + (chain (slot-value buffer 'contents)) + (size (nb-elements chain))) + (loop until (or (= offset size) + (eql (element* chain offset) #\Newline)) + do (incf offset)) + (setf (offset mark) offset)))
(defgeneric line-number (mark) (:documentation "Return the line number of the mark. Lines are numbered from zero."))
Index: climacs/gui.lisp diff -u climacs/gui.lisp:1.58 climacs/gui.lisp:1.59 --- climacs/gui.lisp:1.58 Sun Jan 9 03:42:14 2005 +++ climacs/gui.lisp Sun Jan 9 12:54:50 2005 @@ -277,16 +277,6 @@ (insert-object point object) (forward-object point)))))
-(defgeneric backward-object (mark &optional count)) -(defmethod backward-object ((mark climacs-buffer::mark-mixin) - &optional (count 1)) - (decf (offset mark) count)) - -(defgeneric forward-object (mark &optional count)) -(defmethod forward-object ((mark climacs-buffer::mark-mixin) - &optional (count 1)) - (incf (offset mark) count)) - (define-named-command com-backward-object () (backward-object (point (win *application-frame*))))
Index: climacs/packages.lisp diff -u climacs/packages.lisp:1.24 climacs/packages.lisp:1.25 --- climacs/packages.lisp:1.24 Sun Jan 9 03:46:35 2005 +++ climacs/packages.lisp Sun Jan 9 12:54:50 2005 @@ -42,7 +42,8 @@
(defpackage :climacs-base (:use :clim-lisp :climacs-buffer) - (:export #:previous-line #:next-line + (:export #:forward-object #:backward-object + #:previous-line #:next-line #:open-line #:kill-line #:number-of-lines-in-region #:constituentp #:whitespacep
Index: climacs/syntax.lisp diff -u climacs/syntax.lisp:1.19 climacs/syntax.lisp:1.20 --- climacs/syntax.lisp:1.19 Mon Jan 3 16:07:09 2005 +++ climacs/syntax.lisp Sun Jan 9 12:54:50 2005 @@ -64,6 +64,11 @@ ;;; ;;; Basic syntax
+(defun make-cache () + (let ((cache (make-instance 'standard-flexichain))) + (insert* cache 0 nil) + cache)) + (define-syntax basic-syntax ("Basic" (syntax)) ((top :reader top) (bot :reader bot) @@ -72,7 +77,7 @@ (cursor-y :initform 2) (space-width :initform nil) (tab-width :initform nil) - (cache :initform nil))) + (cache :initform (make-cache))))
(defmethod initialize-instance :after ((syntax basic-syntax) &rest args &key pane) (declare (ignore args)) @@ -151,92 +156,113 @@ (terpri pane) (incf scan))))))
-(defgeneric compute-cache (pane syntax)) +(defgeneric fill-cache (pane syntax) + (:documentation "fill nil cache entries from the buffer"))
-(defmethod compute-cache (pane (syntax basic-syntax)) +(defmethod fill-cache (pane (syntax basic-syntax)) (with-slots (top bot cache) syntax - (let* ((buffer (buffer pane)) - (high-mark (high-mark buffer)) - (low-mark (low-mark buffer))) - (when (or (mark< low-mark top) (mark> high-mark bot)) - (setf cache nil)) - (if (null cache) - (let ((nb-lines-on-display (1+ (number-of-lines-in-region top bot))) - (mark1 (clone-mark top)) - (mark2 (clone-mark top))) - (setf cache (make-instance 'standard-flexichain)) - (loop for line from 0 below nb-lines-on-display - do (beginning-of-line mark1) - (end-of-line mark2) - (insert* cache line (region-to-sequence mark1 mark2)) - unless (end-of-buffer-p mark2) - do (setf (offset mark1) (1+ (offset mark2)) - (offset mark2) (offset mark1)))) - (let ((nb-lines-on-display (1+ (number-of-lines-in-region top bot))) - (mark1 (clone-mark low-mark)) - (mark2 (clone-mark low-mark)) - (size1 (number-of-lines-in-region top low-mark)) - (size2 (number-of-lines-in-region high-mark bot))) - (loop repeat (- (nb-elements cache) size1 size2) - do (delete* cache size1)) - (loop for line from size1 - repeat (- nb-lines-on-display (nb-elements cache)) - do (beginning-of-line mark1) - (end-of-line mark2) - (insert* cache line (region-to-sequence mark1 mark2)) - unless (end-of-buffer-p mark2) - do (setf (offset mark1) (1+ (offset mark2)) - (offset mark2) (offset mark1)))))))) + (let ((mark1 (clone-mark top)) + (mark2 (clone-mark top))) + (loop for line from 0 below (nb-elements cache) + do (beginning-of-line mark1) + (end-of-line mark2) + when (null (element* cache line)) + do (setf (element* cache line) (region-to-sequence mark1 mark2)) + unless (end-of-buffer-p mark2) + do (setf (offset mark1) (1+ (offset mark2)) + (offset mark2) (offset mark1))))))
-(defun position-window (pane syntax) +(defun nb-lines-in-pane (pane) (let* ((medium (sheet-medium pane)) (style (medium-text-style medium)) (height (text-style-height style medium))) + (multiple-value-bind (x y w h) (bounding-rectangle* pane) + (declare (ignore x y w)) + (max 1 (floor h (+ height (stream-vertical-spacing pane))))))) + +;;; make the region on display fit the size of the pane as closely as +;;; possible by adjusting bot leaving top intact. Also make the cache +;;; size fit the size of the region on display. +(defun adjust-cache-size-and-bot (pane syntax) + (let ((nb-lines-in-pane (nb-lines-in-pane pane))) + (with-slots (top bot cache) syntax + (setf (offset bot) (offset top)) + (loop until (end-of-buffer-p bot) + repeat (1- nb-lines-in-pane) + do (forward-object bot) + (end-of-line bot)) + (let ((nb-lines-on-display (1+ (number-of-lines-in-region top bot)))) + (loop repeat (- (nb-elements cache) nb-lines-on-display) + do (pop-end cache)) + (loop repeat (- nb-lines-on-display (nb-elements cache)) + do (push-end cache nil)))))) + +;;; put all-nil entries in the cache +(defun empty-cache (cache) + (loop for i from 0 below (nb-elements cache) + do (setf (element* cache i) nil))) + +;;; empty the cache and try to put point close to the middle +;;; of the pane by moving top half a pane-size up. +(defun reposition-window (pane syntax) + (let ((nb-lines-in-pane (nb-lines-in-pane pane))) + (with-slots (top bot cache) syntax + (empty-cache cache) + (setf (offset top) (offset (point pane))) + (loop do (beginning-of-line top) + repeat (floor nb-lines-in-pane 2) + until (beginning-of-buffer-p top) + do (decf (offset top)) + (beginning-of-line top))))) + +;;; Make the cache reflect the contents of the buffer starting at top, +;;; trying to preserve contents as much as possible, and inserting a +;;; nil entry where buffer contents is unknonwn. The size of the +;;; cache size at the end may be smaller than, equal to, or greater +;;; than the number of lines in the pane. +(defun adjust-cache (pane syntax) + (let* ((buffer (buffer pane)) + (high-mark (high-mark buffer)) + (low-mark (low-mark buffer)) + (nb-lines-in-pane (nb-lines-in-pane pane))) (with-slots (top bot cache) syntax (beginning-of-line top) (end-of-line bot) - (multiple-value-bind (x y w h) (bounding-rectangle* pane) - (declare (ignore x y w)) - (let ((nb-lines-in-pane (max 1 (floor h (+ height (stream-vertical-spacing pane))))) - (nb-lines-on-display (1+ (number-of-lines-in-region top bot)))) - ;; adjust the region on display to fit the pane - (loop repeat (- nb-lines-on-display nb-lines-in-pane) - do (beginning-of-line bot) - (decf (offset bot)) - (unless (null cache) - (pop-end cache))) - (loop until (end-of-buffer-p bot) - repeat (- nb-lines-in-pane nb-lines-on-display) - do (incf (offset bot)) + (if (or (mark< (point pane) top) + (>= (number-of-lines-in-region top (point pane)) nb-lines-in-pane) + (and (mark< low-mark top) + (>= (number-of-lines-in-region top high-mark) (nb-elements cache)))) + (reposition-window pane syntax) + (let* ((n1 (number-of-lines-in-region top low-mark)) + (n2 (1+ (number-of-lines-in-region low-mark high-mark))) + (n3 (number-of-lines-in-region high-mark bot)) + (diff (- (+ n1 n2 n3) (nb-elements cache)))) + (cond ((>= (+ n1 n2 n3) (+ (nb-elements cache) 20)) + (setf (offset bot) (offset top)) (end-of-line bot) - (setf cache nil)) - ;; move region on display if point is outside the current region - (when (or (mark< (point pane) top) (mark> (point pane) bot)) - (setf cache nil) - (setf (offset top) (offset (point pane))) - (loop do (beginning-of-line top) - repeat (floor nb-lines-in-pane 2) - until (beginning-of-buffer-p top) - do (decf (offset top)) - (beginning-of-line top)) - (setf (offset bot) (offset top)) - (loop do (end-of-line bot) - repeat (1- nb-lines-in-pane) - until (end-of-buffer-p bot) - do (incf (offset bot)) - (end-of-line bot)))))))) + (loop for i from n1 below (nb-elements cache) + do (setf (element* cache i) nil))) + ((>= diff 0) + (loop repeat diff do (insert* cache n1 nil)) + (loop for i from (+ n1 diff) below (+ n1 n2) + do (setf (element* cache i) nil))) + (t + (loop repeat (- diff) do (delete* cache n1)) + (loop for i from n1 below (+ n1 n2) + do (setf (element* cache i) nil)))))))) + (adjust-cache-size-and-bot pane syntax))
(defun page-down (pane syntax) - (position-window pane syntax) + (adjust-cache pane syntax) (with-slots (top bot cache) syntax (when (mark> (size (buffer bot)) bot) + (empty-cache cache) (setf (offset top) (offset bot)) (beginning-of-line top) - (setf (offset (point pane)) (offset top)) - (setf cache nil)))) + (setf (offset (point pane)) (offset top)))))
(defun page-up (pane syntax) - (position-window pane syntax) + (adjust-cache pane syntax) (with-slots (top bot cache) syntax (when (> (offset top) 0) (let ((nb-lines-in-region (number-of-lines-in-region top bot))) @@ -247,10 +273,10 @@ do (decf (offset top)) (beginning-of-line top)) (setf (offset (point pane)) (offset top)) - (position-window pane syntax) + (adjust-cache pane syntax) (setf (offset (point pane)) (offset bot)) (beginning-of-line (point pane)) - (setf cache nil))))) + (empty-cache cache)))))
;;; this one should not be necessary. (defun round-up (x) @@ -263,8 +289,8 @@ (style (medium-text-style medium)) (height (text-style-height style medium))) (with-slots (top bot scan cache cursor-x cursor-y) syntax - (position-window pane syntax) - (compute-cache pane syntax) + (adjust-cache pane syntax) + (fill-cache pane syntax) (loop with start-offset = (offset top) for id from 0 below (nb-elements cache) do (setf scan start-offset)