[climacs-cvs] CVS update: climacs/lisp-syntax.lisp - climacs-cvs@common-lisp.net - mailman3.common-lisp.net

13 Jun 2005

Update of /project/climacs/cvsroot/climacs
In directory common-lisp.net:/tmp/cvs-serv23765
Modified Files:
    lisp-syntax.lisp 
Log Message:
Tabs are now handled correctly as far as displaying the cursor is
concerned.
Introduced a lexer error state in which entire lines are returned as
lexemes.  This speeds up the parser after a parse error.
Date: Mon Jun 13 09:08:24 2005
Author: rstrandh
Index: climacs/lisp-syntax.lisp
diff -u climacs/lisp-syntax.lisp:1.5 climacs/lisp-syntax.lisp:1.6

--- climacs/lisp-syntax.lisp:1.5	Wed Jun  1 18:42:28 2005
+++ climacs/lisp-syntax.lisp	Mon Jun 13 09:08:23 2005
@@ -20,8 +20,6 @@
;;; Alternative syntax module for analysing Common Lisp
-;;; move the package definition to packages.lisp later
-
 (in-package :climacs-lisp-syntax)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -64,6 +62,11 @@
   `(defclass ,name (,@superclasses lexer-state)
       ,@body))
+(define-lexer-state lexer-error-state ()
+  ()
+  (:documentation "In this state, the lexer returns error lexemes
+    consisting of entire lines of text"))
+
 (define-lexer-state lexer-toplevel-state ()
   ()
   (:documentation "In this state, the lexer assumes it can skip 
@@ -332,6 +335,12 @@
    			 (fo)))
    		    (t (fo))))))))
+(defmethod lex ((syntax lisp-syntax) (state lexer-error-state) scan)
+  (macrolet ((fo () `(forward-object scan)))
+    (loop until (end-of-line-p scan)
+	  do (fo))
+    (make-instance 'error-lexeme)))
+
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;;
 ;;; nonterminals
@@ -408,7 +417,7 @@
    	   size 0))))
      result))
-(define-parser-state error-state (lexer-toplevel-state parser-state) ())
+(define-parser-state error-state (lexer-error-state parser-state) ())
 (define-parser-state error-reduce-state (lexer-toplevel-state parser-state) ())
(define-lisp-action (error-reduce-state (eql nil))
@@ -899,7 +908,10 @@
     (let* ((cursor-line (number-of-lines-in-region top (point pane)))
       (height (text-style-height (medium-text-style pane) pane))
       (cursor-y (+ (* cursor-line (+ height (stream-vertical-spacing pane)))))
-	   (cursor-column (column-number (point pane)))
+	   (cursor-column 
+	    (buffer-display-column
+	     (buffer (point pane)) (offset (point pane))
+	     (round (tab-width pane) (space-width pane))))
       (cursor-x (* cursor-column (text-style-width (medium-text-style pane) pane))))
       (updating-output (pane :unique-id -1)
    (draw-rectangle* pane

    