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))))