Update of /project/climacs/cvsroot/climacs In directory common-lisp.net:/tmp/cvs-serv3124
Modified Files: gui.lisp html-syntax.lisp packages.lisp pane.lisp syntax.lisp Log Message: Split off the climacs-html-syntax package from the climacs-syntax package. Exported some more symbols from the climacs-syntax package. Implemented a few more functions in the climacs-syntax package that can be used to travarse the parse stack.
The redisplay-pane function now calls a generic function redisplay-pane-with-syntax that also takes a syntax object as argument.
Date: Sat Mar 5 08:03:53 2005 Author: rstrandh
Index: climacs/gui.lisp diff -u climacs/gui.lisp:1.126 climacs/gui.lisp:1.127 --- climacs/gui.lisp:1.126 Mon Feb 28 09:51:33 2005 +++ climacs/gui.lisp Sat Mar 5 08:03:52 2005 @@ -146,7 +146,7 @@ (defun display-win (frame pane) "The display function used by the climacs application frame." (declare (ignore frame)) - (redisplay-pane pane (eq pane (car (windows *application-frame*))))) + (redisplay-pane pane (eq pane (current-window))))
(defmethod handle-repaint :before ((pane extended-pane) region) (declare (ignore region))
Index: climacs/html-syntax.lisp diff -u climacs/html-syntax.lisp:1.5 climacs/html-syntax.lisp:1.6 --- climacs/html-syntax.lisp:1.5 Fri Mar 4 08:17:44 2005 +++ climacs/html-syntax.lisp Sat Mar 5 08:03:53 2005 @@ -20,7 +20,7 @@
;;; Syntax for analysing HTML
-(in-package :climacs-syntax) ;;; Put this in a separate package once it works +(in-package :climacs-html-syntax)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; @@ -34,7 +34,11 @@ (and (eq (class-of t1) (class-of t2)) (< (badness t1) (badness t2))))
-(defclass words (html-sym) ()) +(defclass html-nonterminal (html-sym) + ((start-offset :initarg :start-offset :reader start-offset) + (end-offset :initarg :end-offset :reader end-offset))) + +(defclass words (html-nonterminal) ())
(defclass empty-words (words) ())
@@ -42,7 +46,7 @@ ((words :initarg :words) (word :initarg :word)))
-(defclass html-balanced (html-sym) +(defclass html-balanced (html-nonterminal) ((start :initarg :start) (end :initarg :end)))
@@ -195,17 +199,24 @@ (tag-end (= (end-offset word) (start-offset tag-end)))) :start-mark (start-mark tag-start)) (html -> (<html> head body </html>) + :start-offset (start-offset <html>) :end-offset (end-offset </html>) :start <html> :head head :body body :end </html>) (head -> (<head> title </head>) + :start-offset (start-offset <head>) :end-offset (end-offset </head>) :start <head> :title title :end </head>) (title -> (<title> words </title>) + :start-offset (start-offset <title>) :end-offset (end-offset </title>) :start <title> :words words :end </title>) (body -> (<body> words </body>) + :start-offset (start-offset <body>) :end-offset (end-offset </body>) :start <body> :words words :end </body>) (words -> () - (make-instance 'empty-words)) + (make-instance 'empty-words :start-offset nil)) (words -> (words word) - (make-instance 'nonempty-words :words words :word word)))) + (make-instance 'nonempty-words + :start-offset (or (start-offset words) (start-offset word)) + :end-offset (end-offset word) + :words words :word word))))
(defmethod initialize-instance :after ((syntax html-syntax) &rest args) (declare (ignore args)) @@ -220,6 +231,10 @@ :size 0 :state (initial-state parser)))))
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; +;;; update syntax + (defmethod update-syntax-for-display (buffer (syntax html-syntax) top bot) (with-slots (parser tokens valid-parse) syntax (loop until (= valid-parse (nb-elements tokens)) @@ -267,4 +282,10 @@ do (setf start-mark (clone-mark scan)) (insert* tokens guess-pos (next-token scan)) (incf guess-pos)))))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; +;;; display + +
Index: climacs/packages.lisp diff -u climacs/packages.lisp:1.52 climacs/packages.lisp:1.53 --- climacs/packages.lisp:1.52 Mon Feb 28 09:51:35 2005 +++ climacs/packages.lisp Sat Mar 5 08:03:53 2005 @@ -90,6 +90,11 @@ (:export #:syntax #:define-syntax #:basic-syntax #:update-syntax #:update-syntax-for-display + #:grammar #:parser #:initial-state + #:advance-parse + #:parse-stack-top #:target-parse-tree + #:parse-stack-next #:parse-stack-symbol + #:parse-stack-parse-trees #:map-over-parse-trees #:syntax-line-indentation #:beginning-of-paragraph #:end-of-paragraph))
@@ -126,7 +131,12 @@ #:query-replace-state #:string1 #:string2 #:query-replace-mode #:with-undo + #:redisplay-pane-with-syntax #:url)) + +(defpackage :climacs-html-syntax + (:use :clim-lisp :clim :climacs-buffer :climacs-base + :climacs-syntax :flexichain :climacs-pane))
(defpackage :climacs-gui (:use :clim-lisp :clim :climacs-buffer :climacs-base :climacs-abbrev :climacs-syntax
Index: climacs/pane.lisp diff -u climacs/pane.lisp:1.19 climacs/pane.lisp:1.20 --- climacs/pane.lisp:1.19 Sun Feb 27 19:52:01 2005 +++ climacs/pane.lisp Sat Mar 5 08:03:53 2005 @@ -487,6 +487,11 @@ (+ cursor-x 2) (+ cursor-y (* 0.8 height)) :ink cursor-ink)))))
+(defgeneric redisplay-pane-with-syntax (pane syntax current-p)) + +(defmethod redisplay-pane-with-syntax ((pane climacs-pane) (syntax basic-syntax) current-p) + (display-cache pane (if current-p +red+ +blue+))) + (defgeneric redisplay-pane (pane current-p))
(defmethod redisplay-pane ((pane climacs-pane) current-p) @@ -497,7 +502,7 @@ (adjust-cache pane)) (fill-cache pane) (update-syntax-for-display (buffer pane) (syntax (buffer pane)) (top pane) (bot pane)) - (display-cache pane (if current-p +red+ +blue+))) + (redisplay-pane-with-syntax pane (syntax (buffer pane)) current-p))
(defgeneric full-redisplay (pane))
Index: climacs/syntax.lisp diff -u climacs/syntax.lisp:1.33 climacs/syntax.lisp:1.34 --- climacs/syntax.lisp:1.33 Fri Mar 4 08:17:44 2005 +++ climacs/syntax.lisp Sat Mar 5 08:03:53 2005 @@ -312,6 +312,37 @@ ;;; ;;; Code for analysing parse stack
+(defun parse-stack-top (state) + "for a given state, return the top of the parse stack, or NIL if the parse stack +is empty in that state." + (when (plusp (hash-table-count (incomplete-items state))) + (maphash (lambda (state items) + (declare (ignore state)) + (return-from parse-stack-top (car items))) + (incomplete-items state)))) + +(defun target-parse-tree (state) + "for a given state, return a target parse tree, or NIL if this state does not +represent a complete parse of the target." + (state-contains-target-p state)) + +(defun parse-stack-next (parse-stack) + "given a parse stack frame, return the next frame in the stack." + (assert (not (null parse-stack))) + (predicted-from parse-stack)) + +(defun parse-stack-symbol (parse-stack) + "given a parse stack frame, return the target symbol of the frame." + (assert (not (null parse-stack))) + (left-hand-side (rule parse-stack))) + +(defun parse-stack-parse-trees (parse-stack) + "given a parse stack frame, return a list (in the reverse order of +analysis) of the parse trees recognized. The return value reveals +internal state of the parser. Do not alter it!" + (assert (not (null parse-stack))) + (parse-trees parse-stack)) + (defun map-over-parse-trees (function state) (labels ((map-incomplete-item (item) (unless (null (predicted-from item))