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

Modified Files: klacks-impl.lisp klacks.lisp package.lisp Log Message: klacks xml:base fixes

--- /project/cxml/cvsroot/cxml/klacks/klacks-impl.lisp 2007/03/04 21:04:12 1.6 +++ /project/cxml/cvsroot/cxml/klacks/klacks-impl.lisp 2007/03/04 21:41:07 1.7 @@ -165,9 +165,13 @@ (check-type root (or null rod)) (check-type entity-resolver (or null function symbol)) (check-type disallow-internal-subset boolean) - (let* ((context + (let* ((xstream (car (zstream-input-stack input))) + (name (xstream-name xstream)) + (base (when name (stream-name-uri name))) + (context (make-context :main-zstream input :entity-resolver entity-resolver + :base-stack (list (or base "")) :disallow-internal-subset disallow-internal-subset)) (source (make-instance 'cxml-source @@ -454,25 +458,25 @@ (xstream-name xstream) nil)))

-(defmethod current-line-number ((source cxml-source)) +(defmethod klacks:current-line-number ((source cxml-source)) (let ((x (source-xstream source))) (if x (xstream-line-number x) nil)))

-(defmethod current-column-number ((source cxml-source)) +(defmethod klacks:current-column-number ((source cxml-source)) (let ((x (source-xstream source))) (if x (xstream-column-number x) nil)))

-(defmethod current-system-id ((source cxml-source)) +(defmethod klacks:current-system-id ((source cxml-source)) (let ((name (source-stream-name source))) (if name (stream-name-uri name) nil)))

-(defmethod current-xml-base ((source cxml-source)) +(defmethod klacks:current-xml-base ((source cxml-source)) (car (base-stack (slot-value source 'context))))

--- /project/cxml/cvsroot/cxml/klacks/klacks.lisp 2007/03/04 21:04:12 1.5 +++ /project/cxml/cvsroot/cxml/klacks/klacks.lisp 2007/03/04 21:41:07 1.6 @@ -40,10 +40,10 @@ ;;;(defgeneric klacks:current-characters (source)) (defgeneric klacks:current-cdata-section-p (source))

-(defgeneric current-line-number (source)) -(defgeneric current-column-number (source)) -(defgeneric current-system-id (source)) -(defgeneric current-xml-base (source)) +(defgeneric klacks:current-line-number (source)) +(defgeneric klacks:current-column-number (source)) +(defgeneric klacks:current-system-id (source)) +(defgeneric klacks:current-xml-base (source))

(defmacro klacks:with-open-source ((var source) &body body) `(let ((,var ,source)) @@ -131,9 +131,25 @@ (when document (return document)))))

+(defclass klacksax (sax:sax-parser) + ((source :initarg :source))) + +(defmethod sax:line-number ((parser klacksax)) + (klacks:current-line-number (slot-value parser 'source))) + +(defmethod sax:column-number ((parser klacksax)) + (klacks:current-column-number (slot-value parser 'source))) + +(defmethod sax:system-id ((parser klacksax)) + (klacks:current-system-id (slot-value parser 'source))) + +(defmethod sax:xml-base ((parser klacksax)) + (klacks:current-xml-base (slot-value parser 'source))) + (defun klacks:serialize-element (source handler &key (document-events t)) (unless (eq (klacks:peek source) :start-element) (error "not at start of element")) + (sax:register-sax-parser handler (make-instance 'klacksax :source source)) (when document-events (sax:start-document handler)) (labels ((recurse () --- /project/cxml/cvsroot/cxml/klacks/package.lisp 2007/03/04 18:30:41 1.3 +++ /project/cxml/cvsroot/cxml/klacks/package.lisp 2007/03/04 21:41:07 1.4 @@ -45,4 +45,9 @@ #:serialize-element #:serialize-source

- #:klacks-error)) + #:klacks-error + + #:current-line-number + #:current-column-number + #:current-system-id + #:current-xml-base))