[climacs-cvs] CVS update: climacs/gui.lisp climacs/html-syntax.lisp climacs/packages.lisp climacs/pane.lisp climacs/syntax.lisp
Robert Strandh
rstrandh at common-lisp.net
Sat Mar 5 07:03:55 UTC 2005
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))
More information about the Climacs-cvs
mailing list