December 2004 - climacs-cvs@common-lisp.net

[climacs-cvs] CVS update: climacs/buffer.lisp climacs/io.lisp
by rstrandh＠common-lisp.net 28 Dec '04

28 Dec '04

Update of /project/climacs/cvsroot/climacs In directory common-lisp.net:/tmp/cvs-serv7130 Modified Files: buffer.lisp io.lisp Log Message: Improved performance of loading a file by employing an new addition to the Flexichain library. You will have to update your Flexichain directory from CVS in order for this to work. Date: Tue Dec 28 07:58:36 2004 Author: rstrandh Index: climacs/buffer.lisp diff -u climacs/buffer.lisp:1.11 climacs/buffer.lisp:1.12 --- climacs/buffer.lisp:1.11 Fri Dec 24 09:21:34 2004 +++ climacs/buffer.lisp Tue Dec 28 07:58:36 2004 @@ -327,9 +327,7 @@ sequence.")) (defmethod insert-buffer-sequence ((buffer standard-buffer) offset sequence) - (loop for elem across sequence - do (insert-buffer-object buffer offset elem) - (incf offset))) + (insert-vector* (slot-value buffer 'contents) offset sequence)) (defgeneric insert-object (mark object) (:documentation "Insert the object at the mark. This function simply calls Index: climacs/io.lisp diff -u climacs/io.lisp:1.2 climacs/io.lisp:1.3 --- climacs/io.lisp:1.2 Thu Dec 23 09:00:33 2004 +++ climacs/io.lisp Tue Dec 28 07:58:36 2004 @@ -23,11 +23,14 @@ (in-package :climacs-base) (defun input-from-stream (stream buffer offset) - (let ((eof-object (cons nil nil))) - (loop for obj = (read-char stream nil eof-object) - until (eq obj eof-object) - do (insert-buffer-object buffer offset obj) - (incf offset)))) + (loop with vec = (make-array 10000 :element-type 'character) + for count = (read-sequence vec stream) + while (plusp count) + do (if (= count (length vec)) + (insert-buffer-sequence buffer offset vec) + (insert-buffer-sequence buffer offset + (subseq vec 0 count))) + (incf offset count))) (defun output-to-stream (stream buffer offset1 offset2) (loop for offset from offset1 below offset2

1 0

[climacs-cvs] CVS update: climacs/syntax.lisp
by rstrandh＠common-lisp.net 27 Dec '04

27 Dec '04

Update of /project/climacs/cvsroot/climacs In directory common-lisp.net:/tmp/cvs-serv29501 Modified Files: syntax.lisp Log Message: Improved cursor redisplay. Thanks to Alastair Bridgewater Date: Mon Dec 27 18:43:09 2004 Author: rstrandh Index: climacs/syntax.lisp diff -u climacs/syntax.lisp:1.9 climacs/syntax.lisp:1.10 --- climacs/syntax.lisp:1.9 Mon Dec 27 17:47:45 2004 +++ climacs/syntax.lisp Mon Dec 27 18:43:08 2004 @@ -163,10 +163,13 @@ (multiple-value-bind (x y) (stream-cursor-position pane) (setf cursor-x x cursor-y y))) - (draw-line* pane - cursor-x (- cursor-y (* 0.2 height)) - cursor-x (+ cursor-y (* 0.8 height)) - :ink +red+)))))) + (maybe-updating-output (pane :all-new t :fixed-position t) + (draw-line* pane + ;; cursors with odd x-positions were invisible + ;; so we strip off the low bit to make them even. + (logand -2 cursor-x) (- cursor-y (* 0.2 height)) + (logand -2 cursor-x) (+ cursor-y (* 0.8 height)) + :ink +red+))))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;

1 0

[climacs-cvs] CVS update: climacs/gui.lisp climacs/syntax.lisp
by rstrandh＠common-lisp.net 27 Dec '04

27 Dec '04

Update of /project/climacs/cvsroot/climacs In directory common-lisp.net:/tmp/cvs-serv26651 Modified Files: gui.lisp syntax.lisp Log Message: Patch to get incremental redisplay to work. There is still a small problem with the cursor disappearing. Thanks to Alastair Bridgewater. Date: Mon Dec 27 17:47:46 2004 Author: rstrandh Index: climacs/gui.lisp diff -u climacs/gui.lisp:1.20 climacs/gui.lisp:1.21 --- climacs/gui.lisp:1.20 Mon Dec 27 12:32:46 2004 +++ climacs/gui.lisp Mon Dec 27 17:47:45 2004 @@ -48,7 +48,7 @@ (win (make-pane 'climacs-pane :width 900 :height 400 :name 'win -;;; :incremental-redisplay t + :incremental-redisplay t :display-function 'display-win)) (int :interactor :width 900 :height 50 :max-height 50)) (:layouts Index: climacs/syntax.lisp diff -u climacs/syntax.lisp:1.8 climacs/syntax.lisp:1.9 --- climacs/syntax.lisp:1.8 Mon Dec 27 12:32:46 2004 +++ climacs/syntax.lisp Mon Dec 27 17:47:45 2004 @@ -66,11 +66,11 @@ 'string) :stream pane))) -(defmacro maybe-updating-output (stuff &body body) - `(progn ,@body)) +;;(defmacro maybe-updating-output (stuff &body body) +;; `(progn ,@body)) -;; (defmacro maybe-updating-output (stuff &body body) -;; `(updating-output ,stuff ,@body)) + (defmacro maybe-updating-output (stuff &body body) + `(updating-output ,stuff ,@body)) (defmethod display-line (pane (syntax basic-syntax)) (with-slots (saved-offset bot scan cursor-x cursor-y space-width tab-width) syntax @@ -81,12 +81,18 @@ (macrolet ((output-word (&body body) `(let ((contents (compute-contents))) (if (null contents) - (progn ,@body) + ,(if body + `(maybe-updating-output (pane :unique-id (incf id)) + ,@body) + `(progn)) + (progn (maybe-updating-output (pane :unique-id (incf id) :cache-value contents :cache-test #'string=) - (present-contents contents pane syntax) - ,@body))))) + (present-contents contents pane syntax)) + ,(when body + `(maybe-updating-output (pane :unique-id (incf id)) + ,@body))))))) (loop with id = 0 when (mark= scan (point pane)) do (multiple-value-bind (x y) (stream-cursor-position pane)

1 0

[climacs-cvs] CVS update: climacs/base.lisp climacs/gui.lisp climacs/syntax.lisp
by rstrandh＠common-lisp.net 27 Dec '04

27 Dec '04

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 ,@body)) + +;; (defmacro maybe-updating-output (stuff &body body) +;; `(updating-output ,stuff ,@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) - ,@body))) - (loop when (mark= scan (point pane)) + (if (null contents) + (progn ,@body) + (maybe-updating-output (pane :unique-id (incf id) + :cache-value contents + :cache-test #'string=) + (present-contents contents pane syntax) + ,@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

1 0

[climacs-cvs] CVS update: climacs/gui.lisp
by rstrandh＠common-lisp.net 27 Dec '04

27 Dec '04

Update of /project/climacs/cvsroot/climacs In directory common-lisp.net:/tmp/cvs-serv26075 Modified Files: gui.lisp Log Message: Key bindings for several function keys. Thanks to Alastair Bridgewater. Date: Mon Dec 27 06:58:32 2004 Author: rstrandh Index: climacs/gui.lisp diff -u climacs/gui.lisp:1.18 climacs/gui.lisp:1.19 --- climacs/gui.lisp:1.18 Mon Dec 27 05:32:43 2004 +++ climacs/gui.lisp Mon Dec 27 06:58:29 2004 @@ -93,7 +93,15 @@ do (setf *current-gesture* (read-gesture :stream *standard-input*)) (when (or (characterp *current-gesture*) (and (typep *current-gesture* 'keyboard-event) - (keyboard-event-character *current-gesture*))) + (or (keyboard-event-character *current-gesture*) + (not (member (keyboard-event-key-name + *current-gesture*) + '(:control-left :control-right + :shift-left :shift-right + :meta-left :meta-right + :super-left :super-right + :hyper-left :hyper-right + :shift-lock :caps-lock)))))) (setf gestures (nconc gestures (list *current-gesture*))) (let ((item (find-gestures gestures 'global-climacs-table))) (cond ((not item) @@ -131,6 +139,9 @@ (define-command com-delete-object () (delete-range (point (win *application-frame*)))) +(define-command com-backward-delete-object () + (delete-range (point (win *application-frame*)) -1)) + (define-command com-previous-line () (previous-line (point (win *application-frame*)))) @@ -302,6 +313,19 @@ (global-set-key '(#\< :shift :meta) 'com-beginning-of-buffer) (global-set-key '(#\> :shift :meta) 'com-end-of-buffer) (global-set-key '(#\u :meta) 'com-browse-url) + +(global-set-key '(:up) 'com-previous-line) +(global-set-key '(:down) 'com-next-line) +(global-set-key '(:left) 'com-backward-object) +(global-set-key '(:right) 'com-forward-object) +(global-set-key '(:left :control) 'com-backward-word) +(global-set-key '(:right :control) 'com-forward-word) +(global-set-key '(:home) 'com-beginning-of-line) +(global-set-key '(:end) 'com-end-of-line) +(global-set-key '(:home :control) 'com-beginning-of-buffer) +(global-set-key '(:end :control) 'com-end-of-buffer) +(global-set-key #\Rubout 'com-delete-object) +(global-set-key #\Backspace 'com-backward-delete-object) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;

1 0

[climacs-cvs] CVS update: climacs/gui.lisp climacs/syntax.lisp
by rstrandh＠common-lisp.net 27 Dec '04

27 Dec '04

Update of /project/climacs/cvsroot/climacs In directory common-lisp.net:/tmp/cvs-serv21776 Modified Files: gui.lisp syntax.lisp Log Message: Patch for C-c problem by Alastair Bridgewater. Thanks again. Date: Mon Dec 27 05:32:44 2004 Author: rstrandh Index: climacs/gui.lisp diff -u climacs/gui.lisp:1.17 climacs/gui.lisp:1.18 --- climacs/gui.lisp:1.17 Sun Dec 26 08:18:01 2004 +++ climacs/gui.lisp Mon Dec 27 05:32:43 2004 @@ -86,7 +86,8 @@ (setf (slot-value frame 'win) (find-pane-named frame 'win)) (let ((*standard-output* (frame-standard-output frame)) (*standard-input* (frame-standard-input frame)) - (*print-pretty* nil)) + (*print-pretty* nil) + (*abort-gestures* nil)) (redisplay-frame-panes frame :force-p t) (loop with gestures = '() do (setf *current-gesture* (read-gesture :stream *standard-input*)) @@ -316,7 +317,6 @@ (add-command-to-command-table command 'c-x-climacs-table :keystroke gesture :errorp nil)) -;;; for some reason, C-c does not seem to arrive as far as CLIM. -(c-x-set-key '(#\q :control) 'com-quit) +(c-x-set-key '(#\c :control) 'com-quit) (c-x-set-key '(#\f :control) 'com-find-file) (c-x-set-key '(#\s :control) 'com-save-buffer) Index: climacs/syntax.lisp diff -u climacs/syntax.lisp:1.6 climacs/syntax.lisp:1.7 --- climacs/syntax.lisp:1.6 Sun Dec 26 16:19:59 2004 +++ climacs/syntax.lisp Mon Dec 27 05:32:44 2004 @@ -77,8 +77,7 @@ `(let ((contents (compute-contents))) (present-contents contents pane syntax) ,@body))) - (loop with id = 0 - when (mark= scan (point pane)) + (loop when (mark= scan (point pane)) do (multiple-value-bind (x y) (stream-cursor-position pane) (setf cursor-x (+ x (if (null saved-offset) 0

1 0

[climacs-cvs] CVS update: climacs/syntax.lisp
by rstrandh＠common-lisp.net 26 Dec '04

26 Dec '04

Update of /project/climacs/cvsroot/climacs In directory common-lisp.net:/tmp/cvs-serv13413 Modified Files: syntax.lisp Log Message: Prepared the syntax module for incremental output. I didn't put it in though, because I have problems getting it to work. I'll check with Tim Moore before making another attempt. Date: Sun Dec 26 16:20:00 2004 Author: rstrandh Index: climacs/syntax.lisp diff -u climacs/syntax.lisp:1.5 climacs/syntax.lisp:1.6 --- climacs/syntax.lisp:1.5 Sun Dec 26 08:18:01 2004 +++ climacs/syntax.lisp Sun Dec 26 16:19:59 2004 @@ -59,48 +59,52 @@ (define-presentation-type url () :inherit-from 'string) -(defmethod present-contents (pane (syntax basic-syntax)) - (with-slots (saved-offset scan) syntax - (unless (null saved-offset) - (let ((word (coerce (region-to-sequence saved-offset scan) 'string))) - (present word - (if (and (>= (length word) 7) (string= (subseq word 0 7) "http://")) - 'url - 'string) - :stream pane)) - (setf saved-offset nil)))) +(defmethod present-contents (contents pane (syntax basic-syntax)) + (unless (null contents) + (present contents + (if (and (>= (length contents) 7) (string= (subseq contents 0 7) "http://")) + 'url + 'string) + :stream pane))) (defmethod display-line (pane (syntax basic-syntax)) (with-slots (saved-offset bot scan cursor-x cursor-y space-width tab-width) syntax - (loop 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)))) - cursor-y y)) - when (mark= scan bot) - do (present-contents pane syntax) - (return) - until (eql (object-after scan) #\Newline) - do (let ((obj (object-after scan))) - (cond ((eql obj #\Space) - (present-contents pane syntax) - (princ obj pane)) - ((eql obj #\Tab) - (present-contents pane syntax) - (let ((x (stream-cursor-position pane))) - (stream-increment-cursor-position - pane (- tab-width (mod x tab-width)) 0))) - ((constituentp obj) - (when (null saved-offset) - (setf saved-offset (offset scan)))) - (t - (present-contents pane syntax) - (princ obj pane)))) - (incf (offset scan)) - finally (present-contents pane syntax) - (incf (offset scan)) - (terpri pane)))) + (flet ((compute-contents () + (unless (null saved-offset) + (prog1 (coerce (region-to-sequence saved-offset scan) 'string) + (setf saved-offset nil))))) + (macrolet ((output-word (&body body) + `(let ((contents (compute-contents))) + (present-contents contents pane syntax) + ,@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)))) + cursor-y y)) + when (mark= scan bot) + do (output-word) + (return) + until (eql (object-after scan) #\Newline) + do (let ((obj (object-after scan))) + (cond ((eql obj #\Space) + (output-word (princ obj pane))) + ((eql obj #\Tab) + (output-word) + (let ((x (stream-cursor-position pane))) + (stream-increment-cursor-position + pane (- tab-width (mod x tab-width)) 0))) + ((constituentp obj) + (when (null saved-offset) + (setf saved-offset (offset scan)))) + (t + (output-word (princ obj pane))))) + (incf (offset scan)) + finally (output-word) + (incf (offset scan)) + (terpri pane)))))) (defmethod redisplay-with-syntax (pane (syntax basic-syntax)) (let* ((medium (sheet-medium pane)) @@ -156,13 +160,10 @@ (define-presentation-type texinfo-command () :inherit-from 'string) -(defmethod present-contents (pane (syntax texinfo-syntax)) - (with-slots (saved-offset scan) syntax - (unless (null saved-offset) - (let ((word (coerce (region-to-sequence saved-offset scan) 'string))) - (if (char= (aref word 0) #\@) - (with-drawing-options (pane :ink +red+) - (present word 'texinfo-command :stream pane)) - (present word 'string :stream pane))) - (setf saved-offset nil)))) +(defmethod present-contents (contents pane (syntax texinfo-syntax)) + (unless (null contents) + (if (char= (aref contents 0) #\@) + (with-drawing-options (pane :ink +red+) + (present contents 'texinfo-command :stream pane)) + (present contents 'string :stream pane))))

1 0

[climacs-cvs] CVS update: climacs/base.lisp climacs/gui.lisp climacs/packages.lisp climacs/syntax.lisp
by rstrandh＠common-lisp.net 26 Dec '04

26 Dec '04

Update of /project/climacs/cvsroot/climacs In directory common-lisp.net:/tmp/cvs-serv22191 Modified Files: base.lisp gui.lisp packages.lisp syntax.lisp Log Message: Much improved redisplay algorithm. The behavior when point is outside the current region on display is much faster and similar to that of Emacs, in that the algorithm tries to position point in the middle of the pane. Date: Sun Dec 26 08:18:01 2004 Author: rstrandh Index: climacs/base.lisp diff -u climacs/base.lisp:1.4 climacs/base.lisp:1.5 --- climacs/base.lisp:1.4 Thu Dec 23 09:00:33 2004 +++ climacs/base.lisp Sun Dec 26 08:18:01 2004 @@ -66,6 +66,37 @@ (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)))) + +(defgeneric number-of-lines-in-region (mark1 mark2) + (:documentation "Return the number of lines (or rather the number of +Newline characters) in the region between MARK and MARK2. It is +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)) + +(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)) + +(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))) + (defun constituentp (obj) "A predicate to ensure that an object is a constituent character." (and (characterp obj) Index: climacs/gui.lisp diff -u climacs/gui.lisp:1.16 climacs/gui.lisp:1.17 --- climacs/gui.lisp:1.16 Sat Dec 25 15:49:54 2004 +++ climacs/gui.lisp Sun Dec 26 08:18:01 2004 @@ -46,14 +46,14 @@ ((win :reader win)) (:panes (win (make-pane 'climacs-pane - :width 600 :height 400 + :width 900 :height 400 :name 'win :display-function 'display-win)) - (int :interactor :width 600 :height 50)) + (int :interactor :width 900 :height 50 :max-height 50)) (:layouts (default (vertically () - (scrolling (:width 600 :height 400) win) + (scrolling (:width 900 :height 400) win) int))) (:top-level (climacs-top-level))) Index: climacs/packages.lisp diff -u climacs/packages.lisp:1.10 climacs/packages.lisp:1.11 --- climacs/packages.lisp:1.10 Sat Dec 25 15:49:54 2004 +++ climacs/packages.lisp Sun Dec 26 08:18:01 2004 @@ -44,6 +44,7 @@ (:use :clim-lisp :climacs-buffer) (:export #:previous-line #:next-line #:open-line #:kill-line + #:number-of-lines-in-region #:constituentp #:forward-word #:backward-word #:input-from-stream #:output-to-stream)) Index: climacs/syntax.lisp diff -u climacs/syntax.lisp:1.4 climacs/syntax.lisp:1.5 --- climacs/syntax.lisp:1.4 Sat Dec 25 15:49:54 2004 +++ climacs/syntax.lisp Sun Dec 26 08:18:01 2004 @@ -111,24 +111,30 @@ (end-of-line bot) (multiple-value-bind (x y w h) (bounding-rectangle* pane) (declare (ignore x y w)) - (let ((nb-lines (max 1 (floor h (+ height (stream-vertical-spacing pane)))))) - (loop while (> (1+ (- (line-number bot) (line-number top))) nb-lines) + (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))) (loop until (end-of-buffer-p bot) - while (< (1+ (- (line-number bot) (line-number top))) nb-lines) + repeat (- nb-lines-in-pane nb-lines-on-display) do (incf (offset bot)) (end-of-line bot)) - (loop while (mark< (point pane) top) - do (decf (offset top)) - (beginning-of-line top) - (beginning-of-line bot) - (decf (offset bot))) - (loop while (mark> (point pane) bot) - do (end-of-line top) - (incf (offset top)) - (incf (offset bot)) - (end-of-line bot)) + ;; move region on display if point is outside the current region + (when (or (mark< (point pane) top) (mark> (point pane) bot)) + (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))) (setf (offset scan) (offset top)) (loop until (mark= scan bot) do (display-line pane syntax))

1 0

[climacs-cvs] CVS update: climacs/Doc/climacs-internals.texi
by rstrandh＠common-lisp.net 26 Dec '04

26 Dec '04

Update of /project/climacs/cvsroot/climacs/Doc In directory common-lisp.net:/tmp/cvs-serv18486 Modified Files: climacs-internals.texi Log Message: Added a chapter on the purpose and efficiency considerations concerning the climacs-base package. Date: Sun Dec 26 07:14:52 2004 Author: rstrandh Index: climacs/Doc/climacs-internals.texi diff -u climacs/Doc/climacs-internals.texi:1.3 climacs/Doc/climacs-internals.texi:1.4 --- climacs/Doc/climacs-internals.texi:1.3 Sat Dec 25 15:49:59 2004 +++ climacs/Doc/climacs-internals.texi Sun Dec 26 07:14:51 2004 @@ -443,6 +443,112 @@ concludes the interaction loop and Climacs is again ready to read and execute commands. +@chapter The climacs-base package + +@section Purpose + +The buffer protocol has been designed to be reasonably efficient with +a variety of different implementation strategies (single gap buffer or +sequence of independent lines). It contains (and should only contain) +the absolute minimum of functionality that can be implemented +efficiently independently of strategy. However, this minimum of +functionality is not always convenient. + +The purpose of the climacs-base package is to implement additional +functionality on top of the buffer protocol, in a way that does not +depend on how the buffer protocol was implemented. Thus, the +climacs-base package should remain intact across different +implementation strategies of the buffer protocol. + +Achieving portability of the climacs-base package is not terribly hard +as long as only buffer protocol functions are used. What is slightly +harder is to be sure to maximize efficiency across several +implementation strategies. The next section discusses such +considerations and gives guidelines to implementers of additional +functionality. + +Implementers of the buffer protocol may use the contents of the next +section to make sure they respect the efficiency considerations that +are expected by the climacs-base package. + +@section Efficiency considerations + +In this section, we give a list of rules that implementors of +additional functionality should follow in order to make sure that such +functionality remains efficient (in addition to being portable) across +a variety of implementation strategies of the buffer protocol. + +@quotation Rule +Comparing the position of two marks is efficient, i.e. at most O(log +n) where n is the number of marks in the buffer (which is expected to +be very small compared to the number of objects) in all +implementations. This is true for all types of comparisons. +@end quotation + +It is expected that marks are managed very efficiently. Some balanced +tree management might be necessary, which will make operations have +logarithmic complexity, but only in the number of marks that are +actually used. + +@quotation Rule +While computing and setting the offset of a mark is fairly efficient, +it is not guaranteed to be O(1) even though it might be in an +implementation using a single gap buffer. It might have a complexity +of O(log n) where n is the number of lines in the buffer. This is +true for using incf on the offset of a mark as well, as incf expands +to a setf of the offset. + +Do not hesitate computing or setting the offset of a mark, but avoid +doing it in a tight loop over many objects of the buffer. +@end quotation + +@quotation Rule +Determining whether a mark is at the beginning or at the end of the +buffer is efficient, i.e. O(1), in all implementations. +@end quotation + +@quotation Rule +Determining whether a mark is at the beginning or at the end of a line +is efficient, i.e. O(1), in all implementations. +@end quotation + +@quotation Rule +Going to the beginning or to the end of a line might have linear-time +complexity in the number of characters of the line, though it is +constant-time complexity if the implementation is line oriented. + +It is sometimes inevitable to use this functionality, and since lines +are expected to be short, it should not be avoided at all cost, +especially since it might be very efficient in some implementations. +We do recommend, however to avoid it in tight loops. + +Always use this functionality rather than manually incrementing the +offset of a mark in a loop until a Newline character has been found, +especially since each iteration might take logarithmic time then. +@end quotation + +@quotation Rule +Computing the size of the buffer is always efficient, i.e., O(1). +@end quotation + +@quotation Rule +Computing the number of lines of the buffer is always efficient, i.e., +O(1). +@end quotation + +Implementations of the buffer protocol could always track the number +of insertions and deletions of objects, so there is no reason why this +operation should be inefficient. + +@quotation Rule +Computing the line number of a mark or of an offset can be very +costly, i.e. O(n) where n is size of the buffer. +@end quotation + +This operation is part of the buffer protocol because some +implementations may implement it fairly efficiently, say O(log n) +where n is the number of lines in the buffer. + @chapter Redisplay and the syntax protocol @section General

1 0

[climacs-cvs] CVS update: climacs/Doc/climacs-internals.texi
by rstrandh＠common-lisp.net 25 Dec '04

25 Dec '04

Update of /project/climacs/cvsroot/climacs/Doc In directory common-lisp.net:/tmp/cvs-serv4250/Doc Modified Files: climacs-internals.texi Log Message: Simplified the syntax protocol according to suggestions from Teemu Kalvas. Date: Sat Dec 25 15:50:01 2004 Author: rstrandh Index: climacs/Doc/climacs-internals.texi diff -u climacs/Doc/climacs-internals.texi:1.2 climacs/Doc/climacs-internals.texi:1.3 --- climacs/Doc/climacs-internals.texi:1.2 Sat Dec 25 14:22:59 2004 +++ climacs/Doc/climacs-internals.texi Sat Dec 25 15:49:59 2004 @@ -467,19 +467,20 @@ display after the previous invocation of the redisplay algorithm. @end deftp -@deftp {:initarg} :buffer -Indicates the buffer that this syntax should display. -@end deftp - @deftp {:initarg} :pane Indicates the pane where rendering is to take place. @end deftp -All subclasses of the syntax class must support the :pane and :buffer -initargs. These are both mandatory, because the syntax module needs -to query both the buffer (for things like setting marks that -correspond to the top and the bottom of the pane on display) and the -pane (for things like font size). +All subclasses of the syntax class must support the :pane initarg. +The pane that is passed as an initarg must have a valid buffer +associated with it. + +@deffn {Function} {redisplay-pane} pane + +This function is called by the command loop on every pane that is on +display. It simply calls redisplay-with-syntax with the pane and the +syntax of the pane. +@end deffn @deffn {Generic Function} {redisplay-with-syntax} pane syntax

1 0