Update of /project/climacs/cvsroot/climacs In directory common-lisp.net:/tmp/cvs-serv7705

Modified Files: lisp-syntax.lisp Log Message: Made parse slightly more forgiving e.g. extraneous close paren is marked in red and skipped over.

Date: Mon Sep 5 09:07:28 2005 Author: dmurray

Index: climacs/lisp-syntax.lisp diff -u climacs/lisp-syntax.lisp:1.33 climacs/lisp-syntax.lisp:1.34 --- climacs/lisp-syntax.lisp:1.33 Thu Aug 18 21:49:01 2005 +++ climacs/lisp-syntax.lisp Mon Sep 5 09:07:28 2005 @@ -199,6 +199,8 @@ (defclass complete-token-lexeme (token-mixin form-lexeme) ()) (defclass multiple-escape-start-lexeme (lisp-lexeme) ()) (defclass multiple-escape-end-lexeme (lisp-lexeme) ()) +(defclass incomplete-lexeme (lisp-lexeme) ()) +(defclass unmatched-right-parenthesis-lexeme (lisp-lexeme) ())

(defmethod skip-inter ((syntax lisp-syntax) state scan) (macrolet ((fo () `(forward-object scan))) @@ -224,7 +226,7 @@ (let ((object (object-after scan))) (case object (#( (fo) (make-instance 'left-parenthesis-lexeme)) - ;#) is an error + (#) (fo) (make-instance 'unmatched-right-parenthesis-lexeme)) (#' (fo) (make-instance 'quote-lexeme)) (#; (fo) (loop until (or (end-of-buffer-p scan) @@ -236,7 +238,7 @@ (#` (fo) (make-instance 'backquote-lexeme)) (#, (fo) (cond ((end-of-buffer-p scan) - (make-instance 'error-lexeme)) + (make-instance 'incomplete-lexeme)) (t (case (object-after scan) (#@ (fo) (make-instance 'comma-at-lexeme)) @@ -244,13 +246,13 @@ (t (make-instance 'comma-lexeme)))))) (## (fo) (cond ((end-of-buffer-p scan) - (make-instance 'error-lexeme)) + (make-instance 'incomplete-lexeme)) (t (loop until (end-of-buffer-p scan) while (digit-char-p (object-after scan)) do (fo)) (if (end-of-buffer-p scan) - (make-instance 'error-lexeme) + (make-instance 'incomplete-lexeme) (case (object-after scan) ((#\Backspace #\Tab #\Newline #\Linefeed #\Page #\Return #\Space #)) @@ -258,7 +260,7 @@ (make-instance 'error-lexeme)) (#\ (fo) (cond ((end-of-buffer-p scan) - (make-instance 'error-lexeme)) + (make-instance 'incomplete-lexeme)) ((not (constituentp (object-after scan))) (fo) (make-instance 'character-lexeme)) (t (loop until (end-of-buffer-p scan) @@ -294,6 +296,8 @@ (eql (object-after scan) #()) (fo) (make-instance 'structure-start-lexeme)) + ((end-of-buffer-p scan) + (make-instance 'incomplete-lexeme)) (t (make-instance 'error-lexeme)))) ((#\P #\p) (fo) (make-instance 'pathname-start-lexeme)) @@ -391,7 +395,7 @@ (when (eql (object-after scan) #\) (fo) (when (end-of-buffer-p scan) - (return-from lex-token (make-instance 'error-lexeme))) + (return-from lex-token (make-instance 'incomplete-lexeme))) (fo) (go start)) (when (eql (object-after scan) #|) @@ -409,7 +413,7 @@ (when (eql (object-after scan) #\) (fo) (when (end-of-buffer-p scan) - (return-from lex (make-instance 'error-lexeme))) + (return-from lex (make-instance 'incomplete-lexeme))) (fo) (go start)) (when (eql (object-after scan) #|) @@ -547,6 +551,8 @@

(define-new-lisp-state (|initial-state | form) |initial-state |) (define-new-lisp-state (|initial-state | comment) |initial-state |) +;; skip over unmatched right parentheses +(define-new-lisp-state (|initial-state | unmatched-right-parenthesis-lexeme) |initial-state |)

(define-lisp-action (|initial-state | (eql nil)) (reduce-all form*)) @@ -1198,6 +1204,11 @@ (with-face (:error) (call-next-method)))

+(defmethod display-parse-tree ((parse-symbol unmatched-right-parenthesis-lexeme) + (syntax lisp-syntax) pane) + (with-face (:error) + (call-next-method))) + (define-presentation-type unknown-symbol () :inherit-from 'symbol :description "unknown symbol")

@@ -1365,7 +1376,6 @@ do (display-parse-tree child syntax pane))))

(defmethod redisplay-pane-with-syntax ((pane climacs-pane) (syntax lisp-syntax) current-p) - (declare (ignore current-p)) (with-slots (top bot) pane (setf *cursor-positions* (make-array (1+ (number-of-lines-in-region top bot))) *current-line* 0