klacks xml:base fixes

klacks/klacks-impl.lisp

@@ -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))))
 
 

klacks/klacks.lisp

@@ -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 ()

klacks/package.lisp

@@ -45,4 +45,9 @@
 	   #:serialize-element
 	   #:serialize-source
 
-	   #:klacks-error))
+	   #:klacks-error
+
+	   #:current-line-number
+	   #:current-column-number
+	   #:current-system-id
+	   #:current-xml-base))