Commit a45f2453 authored by Robert Strandh's avatar Robert Strandh

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.
parent fa2bc9e9
......@@ -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))
......
......@@ -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))
......@@ -268,3 +283,9 @@
(insert* tokens guess-pos (next-token scan))
(incf guess-pos))))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; display
......@@ -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,8 +131,13 @@
#: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
:climacs-kill-ring :climacs-pane :clim-extensions :undo))
......
......@@ -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))
......
......@@ -312,6 +312,37 @@ the mark, according to the specified syntax."))
;;;
;;; 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))
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment