From 0fb6bf865140866cf62047e9e337f2551f179343 Mon Sep 17 00:00:00 2001 From: David Lichteblau Date: Sat, 16 Jun 2007 17:47:47 +0200 Subject: [PATCH] Initial commit --- GNUmakefile | 4 +++ cxml-stp.asd | 20 +++++++++++ index.xml | 100 +++++++++++++++++++++++++++++++++++++++++++++++++++ index.xsl | 56 +++++++++++++++++++++++++++++ package.lisp | 59 +++++++++++++++++++++++++++++++ stp.lisp | 114 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 6 files changed, 353 insertions(+) create mode 100644 GNUmakefile create mode 100644 cxml-stp.asd create mode 100644 index.xml create mode 100644 index.xsl create mode 100644 package.lisp create mode 100644 stp.lisp diff --git a/GNUmakefile b/GNUmakefile new file mode 100644 index 0000000..668294b --- /dev/null +++ b/GNUmakefile @@ -0,0 +1,4 @@ +all: index.html + +index.html: index.xml index.xsl + xsltproc index.xsl $< >index.html diff --git a/cxml-stp.asd b/cxml-stp.asd new file mode 100644 index 0000000..25f391c --- /dev/null +++ b/cxml-stp.asd @@ -0,0 +1,20 @@ +(defpackage :cxml-stp-system + (:use :asdf :cl)) +(in-package :cxml-stp-system) + +(defclass closure-source-file (cl-source-file) ()) + +#+sbcl +(defmethod perform :around ((o compile-op) (s closure-source-file)) + ;; shut up already. Correctness first. + (handler-bind ((sb-ext:compiler-note #'muffle-warning)) + (let ((*compile-print* nil)) + (call-next-method)))) + +(defsystem :cxml-stp + :default-component-class closure-source-file + :serial t + :components + ((:file "package") + (:file "stp")) + :depends-on (:cxml)) diff --git a/index.xml b/index.xml new file mode 100644 index 0000000..25621ed --- /dev/null +++ b/index.xml @@ -0,0 +1,100 @@ + +

+ An XML object model for Common Lisp. +

+

+ cxml-stp was written + by David Lichteblau + as an add-on library for + Closure XML. + It is available under an X11-style license. +

+

+ Please send bug reports + to + cxml-devel@common-lisp.net + (list information). +

+ +

Download and Installation

+ +

+ Download a cxml-stp + tarball. +

+

+ cxml-stp needs + Closure XML. + ASDF is used for + compilation. Register the .asd file, e.g. by symlinking it, + then compile cxml-stp using asdf:operate. +

+
$ ln -sf `pwd`/cxml-stp.asd /path/to/your/registry/
+* (asdf:operate 'asdf:load-op :cxml-stp)
+ +

Implementation-specific notes

+

+ At this point, cxml-stp is written to work with Lisp strings + (as opposed to runes and rods), and is meant to be used on + Lisp implementations with Unicode support. +

+ +

Example

+

+ Use cxml-stp:parse-schema + to parse a Relax NG schema file. The + resulting schema + object is a representation of a simplified schema using Lisp + objects, which has gone through simplification as + described the Relax NG + specification. cxml-stp:serialize-schema + can be used to write a Relax NG file in XML syntax for this + grammar. +

+

+ In order to validate XML against a schema, create a + validation handler for the grammar + using cxml-stp:make-validator. + The validation + handler processes SAX events and can be used with any + function generating such events, in particular + with cxml:parse-file. +

+
(cxml:parse-file "example.xml"
+                 (cxml-stp:make-validator
+                  (cxml-stp:parse-schema #p"example.stp")))
+

+ The validator accepts another SAX handler as an optional + second argument. For example, to parse XML into DOM while also + validating it, use the validator like this: +

+
(cxml:parse-file "example.xml"
+                 (cxml-stp:make-validator
+                  (cxml-stp:parse-schema #p"example.stp")
+                  (cxml-dom:make-dom-builder)))
+

+ When using the klacks parser, create a validating source. +

+
(klacks:with-open-source
+    (s (cxml-stp:make-validating-source
+        #p"example.xml"
+        (cxml-stp:parse-schema #p"example.stp")))
+  (loop for key = (klacks:peek-next s) while key do (print key)))
+

+ DTD Compatibility processing (basically, checking of IDs and + addition of default values) is done using a + DTD Compatibility handler. + You can use this handler together with a validator or by its own. +

+
(cxml:parse-file "example.xml"
+                 (cxml-stp:make-dtd-compatibility-handler
+                  (cxml-stp:parse-schema #p"example.stp")
+                  (cxml-dom:make-dom-builder)))
+ +

Documentation

+

+ API documentation is available. +

+
diff --git a/index.xsl b/index.xsl new file mode 100644 index 0000000..7e3fedc --- /dev/null +++ b/index.xsl @@ -0,0 +1,56 @@ + + + + + + + + + + + + + + cxml-rng: Relax NG for Closure XML + + + + + + + + + + + + +
+ +
+
+ + + + + + + + + + +
diff --git a/package.lisp b/package.lisp new file mode 100644 index 0000000..192682b --- /dev/null +++ b/package.lisp @@ -0,0 +1,59 @@ +(defpackage :cxml-stp + (:use :cl) + (:export ) + (:documentation + "@code{cxml-stp} implements ___. + Relax NG} schema validation for Closure XML. + + Support for @a[http://relaxng.org/compact-20021121.html]{Compact Syntax} + and @a[http://relaxng.org/compatibility-20011203.html]{DTD Compatibility} + is included. + + @begin[Example]{section} + @begin{pre}(cxml:parse-file \"test.xml\" + (cxml-rng:make-validator + (cxml-rng:parse-schema #p\"test.rng\"))) + @end{pre} + @end{section} + @begin[Classes]{section} + @aboutclass{schema} + @aboutclass{rng-error} + @aboutclass{dtd-compatibility-error} + @end{section} + @begin[Parsing and validating]{section} + @aboutfun{parse-schema} + @aboutfun{parse-compact} + @aboutfun{make-validator} + @aboutfun{make-dtd-compatibility-handler} + @aboutfun{serialize-grammar} + @end{section} + @begin[Grammar introspection]{section} + The following classes and function are exported so that users can + take a peek at the internals of the parsed and simplified grammar. + + @aboutfun{schema-start} + @aboutclass{attribute} + @aboutclass{choice} + @aboutclass{data} + @aboutclass{element} + @aboutclass{empty} + @aboutclass{group} + @aboutclass{interleave} + @aboutclass{list-pattern} + @aboutclass{not-allowed} + @aboutclass{one-or-more} + @aboutclass{pattern} + @aboutclass{ref} + @aboutclass{text} + @aboutclass{value} + @aboutfun{pattern-child} + @aboutfun{pattern-a} + @aboutfun{pattern-b} + @aboutfun{pattern-name} + @aboutfun{pattern-element} + @aboutfun{pattern-type} + @aboutfun{pattern-string} + @aboutfun{pattern-value} + @aboutfun{pattern-params} + @aboutfun{pattern-except} + @end{section}")) diff --git a/stp.lisp b/stp.lisp new file mode 100644 index 0000000..29f2631 --- /dev/null +++ b/stp.lisp @@ -0,0 +1,114 @@ +(in-package :cxml-stp) + +(defclass node () + (;; (document :reader document) + ;; (base-uri :accessor base-uri) + (parent :accessor parent))) + +(defun document (node) + (check-type node node) + (loop + for parent = this then (parent parent) + while (and parent (not (typep parent 'document))) + finally (return parent))) + +(defun document (node) + (check-type node node) + (loop + for p = parent then (parent p) + and q = p + while p + finally (return q))) + +(defgeneric base-uri (node)) ;fixme: hier muessen wir wissen, ob specified +(defmethod base-uri ((node node)) + (let ((parent (parent node))) + (if parent + (base-uri parent) + ""))) + +(defmethod detach ((node node)) + (when (parent node) + (delete-child node (parent node)))) + +(defgeneric string-value (node)) +(defgeneric children (node)) +(defgeneric copy (node)) +(defgeneric unparse (node handler)) + +(defgeneric node= (node)) +(defmethod node= ((node node) x) + (eq node x)) + +(defgeneric (setf base-uri) (newval node)) ;s.o. + + +;; print-object nicht vergessen + +(defun query (node xpath) + ;; fixme + ) + + + + +(defgeneric make-document ((root element)) + ;; fixme + ) + +(defgeneric make-document ((document document)) + ;; wtf? + ) + +(defclass document (parent-node) + ) + +(defun document-type (document) + ) + +(defun root-element (document) + ) + +(defun (setf root-element) (newval document) + (check-type element newval) + ) + +(defun check-root (document) + ;; was macht das? + ) + +(defclass parent-node (node) + ((children :reader children))) + +(defun (setf childen) (newval node) + (replace-children node newval)) + +(defun replace-children (node new-children &key start1 end1 start2 end2) + ) + +(defun insert-child (child parent position) + ) + +(defun prepend-child (child parent) + ) + +(defun append-child (child parent) + ) + +(defun child-position (child parent &key start end test key from-end) + ) + +(defun delete-child (child document &key start end count test from-end) + ) + +(defun delete-child-if (predicate document &key start end count key from-end) + ) + + + + +(defclass attribute ...) + +(defmethod detach ((node attribute)) + (when (parent node) + (delete-attribute node (parent node)))) -- 2.11.4.GIT