OSCL/CXML
2
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

klacks xml:base fixes

Browse Source
This commit is contained in:
dlichteblau
2007-03-04 21:41:07 +00:00
parent e0e54c172f
commit c43b58dd3e
3 changed files with 35 additions and 10 deletions
Download Patch File Download Diff File Expand all files Collapse all files

14
klacks/klacks-impl.lisp
View File

@ -165,9 +165,13 @@
(check-type root (or null rod)) (check-type root (or null rod))
(check-type entity-resolver (or null function symbol)) (check-type entity-resolver (or null function symbol))
(check-type disallow-internal-subset boolean) (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 (make-context :main-zstream input
:entity-resolver entity-resolver :entity-resolver entity-resolver
:base-stack (list (or base ""))
:disallow-internal-subset disallow-internal-subset)) :disallow-internal-subset disallow-internal-subset))
(source (source
(make-instance 'cxml-source (make-instance 'cxml-source
@ -454,25 +458,25 @@
(xstream-name xstream) (xstream-name xstream)
nil))) nil)))
(defmethod current-line-number ((source cxml-source)) (defmethod klacks:current-line-number ((source cxml-source))
(let ((x (source-xstream source))) (let ((x (source-xstream source)))
(if x (if x
(xstream-line-number x) (xstream-line-number x)
nil))) nil)))
(defmethod current-column-number ((source cxml-source)) (defmethod klacks:current-column-number ((source cxml-source))
(let ((x (source-xstream source))) (let ((x (source-xstream source)))
(if x (if x
(xstream-column-number x) (xstream-column-number x)
nil))) nil)))
(defmethod current-system-id ((source cxml-source)) (defmethod klacks:current-system-id ((source cxml-source))
(let ((name (source-stream-name source))) (let ((name (source-stream-name source)))
(if name (if name
(stream-name-uri name) (stream-name-uri name)
nil))) nil)))
(defmethod current-xml-base ((source cxml-source)) (defmethod klacks:current-xml-base ((source cxml-source))
(car (base-stack (slot-value source 'context)))) (car (base-stack (slot-value source 'context))))

24
klacks/klacks.lisp
View File

@ -40,10 +40,10 @@
;;;(defgeneric klacks:current-characters (source)) ;;;(defgeneric klacks:current-characters (source))
(defgeneric klacks:current-cdata-section-p (source)) (defgeneric klacks:current-cdata-section-p (source))
(defgeneric current-line-number (source)) (defgeneric klacks:current-line-number (source))
(defgeneric current-column-number (source)) (defgeneric klacks:current-column-number (source))
(defgeneric current-system-id (source)) (defgeneric klacks:current-system-id (source))
(defgeneric current-xml-base (source)) (defgeneric klacks:current-xml-base (source))
(defmacro klacks:with-open-source ((var source) &body body) (defmacro klacks:with-open-source ((var source) &body body)
`(let ((,var ,source)) `(let ((,var ,source))
@ -131,9 +131,25 @@
(when document (when document
(return 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)) (defun klacks:serialize-element (source handler &key (document-events t))
(unless (eq (klacks:peek source) :start-element) (unless (eq (klacks:peek source) :start-element)
(error "not at start of element")) (error "not at start of element"))
(sax:register-sax-parser handler (make-instance 'klacksax :source source))
(when document-events (when document-events
(sax:start-document handler)) (sax:start-document handler))
(labels ((recurse () (labels ((recurse ()

7
klacks/package.lisp
View File

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