Update of /project/cxml/cvsroot/cxml/klacks In directory clnet:/tmp/cvs-serv2817/klacks
Modified Files: klacks-impl.lisp klacks.lisp Log Message: xml:base
--- /project/cxml/cvsroot/cxml/klacks/klacks-impl.lisp 2007/02/18 16:46:33 1.5 +++ /project/cxml/cvsroot/cxml/klacks/klacks-impl.lisp 2007/03/04 21:04:12 1.6 @@ -356,11 +356,12 @@
(defun klacks/entity-reference (source zstream name cont) (assert (not (zstream-token-category zstream))) - (with-source (source temporary-streams) + (with-source (source temporary-streams context) (let ((new-xstream (entity->xstream zstream name :general nil))) (push new-xstream temporary-streams) (push :stop (zstream-input-stack zstream)) (zstream-push new-xstream zstream) + (push (stream-name-uri (xstream-name new-xstream)) (base-stack context)) (let ((next (lambda () (klacks/entity-reference-2 source zstream new-xstream cont)))) @@ -371,12 +372,13 @@ (klacks/ext-parsed-ent source zstream next)))))))
(defun klacks/entity-reference-2 (source zstream new-xstream cont) - (with-source (source temporary-streams) + (with-source (source temporary-streams context) (unless (eq (peek-token zstream) :eof) (wf-error zstream "Trailing garbage. - ~S" (peek-token zstream))) (assert (eq (peek-token zstream) :eof)) (assert (eq (pop (zstream-input-stack zstream)) new-xstream)) (assert (eq (pop (zstream-input-stack zstream)) :stop)) + (pop (base-stack context)) (setf (zstream-token-category zstream) nil) (setf temporary-streams (remove new-xstream temporary-streams)) (close-xstream new-xstream) @@ -441,6 +443,39 @@ element-name attribute-name type default))
+;;;; locator + +(defun source-xstream (source) + (car (zstream-input-stack (main-zstream (slot-value source 'context))))) + +(defun source-stream-name (source) + (let ((xstream (source-xstream source))) + (if xstream + (xstream-name xstream) + nil))) + +(defmethod 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)) + (let ((x (source-xstream source))) + (if x + (xstream-column-number x) + nil))) + +(defmethod 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)) + (car (base-stack (slot-value source 'context)))) + + ;;;; debugging
#+(or) --- /project/cxml/cvsroot/cxml/klacks/klacks.lisp 2007/03/04 18:30:41 1.4 +++ /project/cxml/cvsroot/cxml/klacks/klacks.lisp 2007/03/04 21:04:12 1.5 @@ -40,6 +40,11 @@ ;;;(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)) + (defmacro klacks:with-open-source ((var source) &body body) `(let ((,var ,source)) (unwind-protect