Update of /project/cxml/cvsroot/cxml/klacks In directory clnet:/tmp/cvs-serv13701/klacks

Modified Files: klacks-impl.lisp klacks.lisp Log Message: klacks fixes

--- /project/cxml/cvsroot/cxml/klacks/klacks-impl.lisp 2007/02/18 11:07:40 1.2 +++ /project/cxml/cvsroot/cxml/klacks/klacks-impl.lisp 2007/02/18 14:35:15 1.3 @@ -31,7 +31,7 @@ (current-values) (current-attributes) (cdata-section-p :reader klacks:current-cdata-section-p) - ;; extra with-source magic + ;; extra WITH-SOURCE magic (data-behaviour :initform :DTD) (namespace-stack :initform (list *initial-namespace-bindings*)) (temporary-streams :initform nil) @@ -126,13 +126,18 @@ (apply #'make-source xstream args))) (pathname (let* ((xstream - (make-xstream (open input :element-type '(unsigned-byte 8)))) - (source (apply #'make-source - xstream - :pathname input - args))) - (push xstream (slot-value source 'temporary-streams)) - source)) + (make-xstream (open input :element-type '(unsigned-byte 8))))) + (setf (xstream-name xstream) + (make-stream-name + :entity-name "main document" + :entity-kind :main + :uri (pathname-to-uri (merge-pathnames input)))) + (let ((source (apply #'make-source + xstream + :pathname input + args))) + (push xstream (slot-value source 'temporary-streams)) + source))) (rod (let ((xstream (string->xstream input))) (setf (xstream-name xstream) @@ -152,8 +157,7 @@ (check-type entity-resolver (or null function symbol)) (check-type disallow-internal-subset boolean) (let* ((context - (make-context :handler nil - :main-zstream input + (make-context :main-zstream input :entity-resolver entity-resolver :disallow-internal-subset disallow-internal-subset)) (source @@ -167,6 +171,7 @@ :scratch-pad-2 *scratch-pad-2* :scratch-pad-3 *scratch-pad-3* :scratch-pad-4 *scratch-pad-4*))) + (setf (handler context) (make-instance 'klacks-dtd-handler :source source)) (setf (slot-value source 'continuation) (lambda () (klacks/xmldecl source input))) source)) @@ -208,25 +213,26 @@ (defun klacks/doctype (source input) (with-source (source current-key current-values validate dtd) (let ((cont (lambda () (klacks/finish-doctype source input))) - ignoreme name extid) + l) (prog1 (cond ((eq (peek-token input) :<!DOCTYPE) - (setf (values ignoreme name extid) - (p/doctype-decl input dtd)) + (setf l (cdr (p/doctype-decl input dtd))) (lambda () (klacks/misc*-2 source input cont))) (dtd - (setf (values ignoreme name extid) - (synthesize-doctype dtd input)) + (setf l (cdr (synthesize-doctype dtd input))) cont) ((and validate (not dtd)) (validity-error "invalid document: no doctype")) (t (return-from klacks/doctype (funcall cont)))) - (setf current-key :dtd) - (setf current-values - (list name (extid-public extid) (extid-system extid))))))) + (destructuring-bind (&optional name extid) l + (setf current-key :dtd) + (setf current-values + (list name + (and extid (extid-public extid)) + (and extid (extid-system extid)))))))))

(defun klacks/finish-doctype (source input) (with-source (source current-key current-values root data-behaviour) @@ -323,7 +329,7 @@ (klacks/entity-reference source input name recurse))) ((:<![) (setf current-key :characters) - (setf current-values (list (process-cdata-section input sem))) + (setf current-values (list (process-cdata-section input))) (setf cdata-section-p t) recurse) ((:PI) @@ -376,6 +382,58 @@ (set-full-speed input) (klacks/content source input cont)))

+ +;;;; terrible kludges + +(defclass klacks-dtd-handler () + ((handler-source :initarg :source :reader handler-source) + (internal-subset-p :initform nil :accessor handler-internal-subset-p))) + +(defmethod sax:start-internal-subset ((handler klacks-dtd-handler)) + (setf (slot-value (handler-source handler) 'internal-declarations) '()) + (setf (handler-internal-subset-p handler) t)) + +(defmethod sax:end-internal-subset ((handler klacks-dtd-handler)) + (setf (handler-internal-subset-p handler) nil)) + +(defmethod sax:entity-resolver ((handler klacks-dtd-handler) fn) + (setf (slot-value (handler-source handler) 'dom-impl-entity-resolver) fn)) + +(defmethod sax::dtd ((handler klacks-dtd-handler) dtd) + (setf (slot-value (handler-source handler) 'dom-impl-dtd) dtd)) + +(defmethod sax:end-dtd ((handler klacks-dtd-handler)) + (let ((source (handler-source handler))) + (when (slot-boundp source 'internal-declarations) + (setf (slot-value source 'internal-declarations) + (reverse (slot-value source 'internal-declarations))) + (setf (slot-value source 'external-declarations) + (reverse (slot-value source 'external-declarations)))))) + +(macrolet + ((defhandler (name &rest args) + `(defmethod ,name ((handler klacks-dtd-handler) ,@args) + (let ((source (handler-source handler)) + (spec (list ',name ,@args))) + (if (handler-internal-subset-p handler) + (push spec (slot-value source 'internal-declarations)) + (push spec (slot-value source 'external-declarations))))))) + (defhandler sax:unparsed-entity-declaration + name public-id system-id notation-name) + (defhandler sax:external-entity-declaration + kind name public-id system-id) + (defhandler sax:internal-entity-declaration + kind name value) + (defhandler sax:notation-declaration + name public-id system-id) + (defhandler sax:element-declaration + name model) + (defhandler sax:attribute-declaration + element-name attribute-name type default)) + + +;;;; debugging + #+(or) (trace CXML::KLACKS/DOCTYPE CXML::KLACKS/EXT-PARSED-ENT --- /project/cxml/cvsroot/cxml/klacks/klacks.lisp 2007/02/11 18:21:20 1.1 +++ /project/cxml/cvsroot/cxml/klacks/klacks.lisp 2007/02/18 14:35:15 1.2 @@ -18,7 +18,13 @@

(in-package :cxml)

-(defclass klacks:source () ()) +(defclass klacks:source () + ( + ;; fixme, terrible DTD kludges + (internal-declarations) + (external-declarations :initform nil) + (dom-impl-dtd :initform nil) + (dom-impl-entity-resolver :initform nil)))

(defgeneric klacks:close-source (source))

@@ -83,7 +89,19 @@ (sax:comment handler a)) (:dtd (sax:start-dtd handler a b c) - (sax:end-dtd handler)) + (when (slot-boundp source 'internal-declarations) + (sax:start-internal-subset handler) + (serialize-declaration-kludge + (slot-value source 'internal-declarations) + handler) + (sax:end-internal-subset handler)) + (serialize-declaration-kludge + (slot-value source 'external-declarations) + handler) + (sax:end-dtd handler) + (sax:entity-resolver handler + (slot-value source 'dom-impl-entity-resolver)) + (sax::dtd handler (slot-value source 'dom-impl-dtd))) (:start-element (sax:start-element handler a b c (klacks:list-attributes source))) (:end-element @@ -93,3 +111,8 @@ (t (error "unexpected klacks key: ~A" key))) (klacks:consume source)))) + +(defun serialize-declaration-kludge (list handler) + (loop + for (fn . args) in list + do (apply fn handler args)))