Update of /project/climacs/cvsroot/climacs In directory clnet:/tmp/cvs-serv2794

Modified Files: prolog-syntax.lisp Log Message: Fix Prolog-syntax (well, one can hope). Should now work with the crazy Drei cursor-positioning code, and not defer redisplay to the method for Fundamental syntax.

--- /project/climacs/cvsroot/climacs/prolog-syntax.lisp 2006/11/12 16:06:06 1.30 +++ /project/climacs/cvsroot/climacs/prolog-syntax.lisp 2006/11/16 15:05:23 1.31 @@ -1218,31 +1218,32 @@

(defvar *white-space-start* nil)

-(defvar *cursor-positions* nil) (defvar *current-line* 0)

(defun handle-whitespace (pane buffer start end) (let ((space-width (space-width pane)) - (tab-width (tab-width pane))) - (loop while (< start end) - do (case (buffer-object buffer start) - (#\Newline (terpri pane) - (stream-increment-cursor-position - pane (first (aref *cursor-positions* *current-line*)) 0) - (setf (aref *cursor-positions* (incf *current-line*)) - (multiple-value-list (stream-cursor-position pane)))) - ((#\Page #\Return #\Space) (stream-increment-cursor-position - pane space-width 0)) - (#\Tab (let ((x (stream-cursor-position pane))) - (stream-increment-cursor-position - pane (- tab-width (mod x tab-width)) 0)))) - (incf start)))) + (tab-width (tab-width pane))) + (with-sheet-medium (medium pane) + (with-accessors ((cursor-positions cursor-positions)) (syntax buffer) + (loop while (< start end) + do (case (buffer-object buffer start) + (#\Newline (record-line-vertical-offset pane (syntax buffer) (incf *current-line*)) + (terpri pane) + (stream-increment-cursor-position + pane (first (aref cursor-positions 0)) 0)) + ((#\Page #\Return #\Space) (stream-increment-cursor-position + pane space-width 0)) + (#\Tab (let ((x (stream-cursor-position pane))) + (stream-increment-cursor-position + pane (- tab-width (mod x tab-width)) 0)))) + (incf start))))))

(defmethod display-parse-tree :around ((entity prolog-parse-tree) (syntax prolog-syntax) (stream extended-output-stream) (drei drei)) (with-slots (top bot) drei - (when (and (end-offset entity) (mark> (end-offset entity) top)) - (call-next-method)))) + (when (and (end-offset entity) + (mark> (end-offset entity) top)) + (call-next-method))))

(defmethod display-parse-tree ((entity prolog-token) (syntax prolog-syntax) (stream extended-output-stream) (drei drei)) @@ -1313,12 +1314,15 @@ (defun nb-valid-lexemes (lexer) (slot-value lexer 'valid-lex))

-(defmethod display-drei-contents ((stream extended-output-stream) (drei drei) (syntax prolog-syntax)) +(defmethod display-drei-contents ((stream clim-stream-pane) (drei drei) (syntax prolog-syntax)) (with-slots (top bot) drei (with-accessors ((cursor-positions cursor-positions)) syntax - (setf cursor-positions (make-array (1+ (number-of-lines-in-region top bot))) + (setf cursor-positions (make-array (1+ (number-of-lines-in-region top bot)) + :initial-element nil) *current-line* 0 - (aref cursor-positions 0) (multiple-value-list (stream-cursor-position stream)))) + (aref cursor-positions 0) (multiple-value-list + (stream-cursor-position stream)))) + (setf *white-space-start* (offset top)) (with-slots (lexer) syntax (let ((average-token-size (max (float (/ (size (buffer drei)) (nb-valid-lexemes lexer))) 1.0))) @@ -1338,17 +1342,16 @@ (not (parse-state-empty-p (slot-value (lexeme lexer (1- start-token-index)) 'state)))) do (decf start-token-index)) - (let ((*white-space-start* (offset top))) - ;; display the parse tree if any - (unless (parse-state-empty-p (slot-value (lexeme lexer (1- start-token-index)) 'state)) - (display-parse-state (slot-value (lexeme lexer (1- start-token-index)) 'state) - syntax stream drei)) - ;; display the lexemes - (with-drawing-options (stream :ink +red+) - (loop while (< start-token-index end-token-index) - do (let ((token (lexeme lexer start-token-index))) - (display-parse-tree token syntax stream drei)) - (incf start-token-index)))))))))) + ;; display the parse tree if any + (unless (parse-state-empty-p (slot-value (lexeme lexer (1- start-token-index)) 'state)) + (display-parse-state (slot-value (lexeme lexer (1- start-token-index)) 'state) + syntax stream drei)) + ;; display the lexemes + (with-drawing-options (stream :ink +red+) + (loop while (< start-token-index end-token-index) + do (let ((token (lexeme lexer start-token-index))) + (display-parse-tree token syntax stream drei)) + (incf start-token-index)))))))))

#| (climacs-gui::define-named-command com-inspect-lex ()