[climacs-cvs] CVS update: climacs/prolog-syntax.lisp
Christophe Rhodes
crhodes at common-lisp.net
Wed Apr 6 17:00:21 UTC 2005
Update of /project/climacs/cvsroot/climacs
In directory common-lisp.net:/tmp/cvs-serv365
Modified Files:
prolog-syntax.lisp
Log Message:
Because of multiline tokens, we must redraw on various criteria other than
the ink and face changing: specifically, if the substring of the token
that we are to draw is different, we cannot simply displace or replay an
output record.
Date: Wed Apr 6 19:00:20 2005
Author: crhodes
Index: climacs/prolog-syntax.lisp
diff -u climacs/prolog-syntax.lisp:1.14 climacs/prolog-syntax.lisp:1.15
--- climacs/prolog-syntax.lisp:1.14 Wed Apr 6 18:23:21 2005
+++ climacs/prolog-syntax.lisp Wed Apr 6 19:00:20 2005
@@ -56,7 +56,7 @@
())
(defclass prolog-token (prolog-parse-tree)
- ((ink) (face)))
+ ((ink) (face) (start) (end)))
;;; lexer
@@ -947,40 +947,47 @@
(call-next-method))))
(defmethod display-parse-tree ((entity prolog-token) (syntax prolog-syntax) pane)
- (flet ((cache-test (t1 t2)
- (and (eq t1 t2)
- (eq (slot-value t1 'ink)
- (medium-ink (sheet-medium pane)))
- (eq (slot-value t1 'face)
- (text-style-face (medium-text-style (sheet-medium pane)))))))
- (updating-output (pane :unique-id entity
- :id-test #'eq
- :cache-value entity
- :cache-test #'cache-test)
- (with-slots (ink face) entity
- (setf ink (medium-ink (sheet-medium pane))
- face (text-style-face (medium-text-style (sheet-medium pane))))
- (let ((string (coerce (buffer-sequence (buffer syntax)
- (start-offset entity)
- (end-offset entity))
- 'string)))
- (with-slots (top bot) pane
- (let (start end)
- (setf start (max 0 (- (offset top) (start-offset entity))))
- (setf end (- (length string) (max 0 (- (end-offset entity) (offset bot)))))
- (loop
- (when (>= start end)
- (return))
- (let ((nl (position #\Newline string
- :start start :end end)))
- (unless nl
- (present (subseq string start end) 'string :stream pane)
- (return))
- (present (subseq string start nl) 'string :stream pane)
- (handle-whitespace pane (buffer pane)
- (+ (start-offset entity) nl)
- (+ (start-offset entity) nl 1))
- (setf start (+ nl 1)))))))))))
+ (with-slots (top bot) pane
+ (let ((string (coerce (buffer-sequence (buffer syntax)
+ (start-offset entity)
+ (end-offset entity))
+ 'string)))
+ (flet ((cache-test (t1 t2)
+ (and (eq t1 t2)
+ (eq (slot-value t1 'ink)
+ (medium-ink (sheet-medium pane)))
+ (eq (slot-value t1 'face)
+ (text-style-face (medium-text-style (sheet-medium pane))))
+ (eq (slot-value t1 'start)
+ (max 0 (- (offset top) (start-offset entity))))
+ (eq (slot-value t1 'end)
+ (- (length string)
+ (max 0 (- (end-offset entity) (offset bot))))))))
+ (updating-output (pane :unique-id entity
+ :id-test #'eq
+ :cache-value entity
+ :cache-test #'cache-test)
+ (with-slots (ink face start end) entity
+ (setf ink (medium-ink (sheet-medium pane))
+ face (text-style-face (medium-text-style (sheet-medium pane)))
+ start (max 0 (- (offset top) (start-offset entity)))
+ end (- (length string)
+ (max 0 (- (end-offset entity) (offset bot)))))
+ (let ((start start)
+ (end end))
+ (loop
+ (when (>= start end)
+ (return))
+ (let ((nl (position #\Newline string
+ :start start :end end)))
+ (unless nl
+ (present (subseq string start end) 'string :stream pane)
+ (return))
+ (present (subseq string start nl) 'string :stream pane)
+ (handle-whitespace pane (buffer pane)
+ (+ (start-offset entity) nl)
+ (+ (start-offset entity) nl 1))
+ (setf start (+ nl 1)))))))))))
(defmethod display-parse-tree :before ((entity prolog-token) (syntax prolog-syntax) pane)
(handle-whitespace pane (buffer pane) *white-space-start* (start-offset entity))
More information about the Climacs-cvs
mailing list