Commit d967327e authored by david's avatar david

*** empty log message ***

parent 8f937493
--- orig/xml/xml-parse.lisp
+++ mod/xml/xml-parse.lisp
@@ -525,7 +525,10 @@
(declaim (type (simple-array rune (*))
*scratch-pad* *scratch-pad-2* *scratch-pad-3* *scratch-pad-4*))
-(defmacro with-scratch-pads (() &body body)
+(defmacro with-scratch-pads (#-clisp ()
+ ;; clisp does not allow () as macro argument list
+ #+clisp (&key &allow-other-keys)
+ &body body)
`(let ((*scratch-pad* (make-array 1024 :element-type 'rune))
(*scratch-pad-2* (make-array 1024 :element-type 'rune))
(*scratch-pad-3* (make-array 1024 :element-type 'rune))
all:
@echo no such target
@exit 1
.PHONY: clean
clean:
touch dummy.fasl
find . \( -name \*.fasl -o -name \*.x86f \) -print0 | xargs -0 rm
Changes to Gilbert Baumann's Code
========================================
(Stand dieser Liste: patch-54)
base-0
Import of Closure's src/xml and src/glisp
Build system
----------------
patch-14
dom-builder.lsp braucht package.lisp
patch-17
xml-parse braucht dom-impl
patch-18
xml-parse braucht encodings
patch-19
xml-parse.lisp needs xml-stream.lisp
Interface changes
----------------
patch-2
export UNPARSE-DOCUMENT
Portability issues
----------------
patch-1
ACL port aktualisiert
patch-8
fixed more mlisp breakage
DOM fixes
----------------
patch-3
add dom:remove-child, dom:import-node
patch-6
fixed dom:remove-child
patch-7
strings->rods in set-attribute, too
patch-21
dom:item und dom:length fuer NodeList implementiert
patch-22
s/remove-atttribute/remove-attribute
patch-23
dom:remove-attribute-node korrigiert
patch-24
neu: dom:remove-attribute
patch-25
dom:normalize implementiert
patch-26
get-elements-by-tag-name fuer Element implementiert
patch-32
s/data/value/ fuer CHARACTER-DATA
patch-33
Aufruf von Setter-Methoden
patch-34
(setf value) nachgetragen
patch-35
(DOM:NODE-VALUE ATTRIBUTE) korrigiert
patch-36
writer fuer DOM:DATA
patch-37
(setf dom:node-value) implementiert
patch-43
hack: implemented CHILD-NODES for ENTITY-REFERENCE
patch-44
ENTITY-REFERENCE-Kinder als read-only markieren
patch-45
DOM-EXCEPTION implementiert
patch-46
fixed special cases in delete-data and replace-data
patch-47
delete-data: Arraytyp korrigiert
patch-48
DOM:INSERT-DATA implementiert
patch-49
bugfix: replace-data for count != (length arg)
patch-50
patch-46 nachgebessert: offset == length ist OK
patch-51
fixed special cases in dom:substring-data
patch-52
fixed patch-36, my (setf dom:data) implementation was bogus
xml-parse.lisp changes
----------------
patch-5
(assert (eql initial-speed 1)) in make-xstream
patch-20
added a forward declaration for *namespace-bindings*
patch-39
fix for thread safety in p/document
patch-41
Warnung ueber (nicht) redefinierte Attribute abschalten koennen
patch-54
call sax:comment; create comment nodes
String-Handling
----------------
patch-4
renamed dom to cdom, added string-dom
patch-38
diverse setter nachgetragen
Misc.
----------------
patch-9
print elements with their tag-name
patch-11
print attributes with name and value
patch-10
(reverted by patch-10)
patch-12
REVERT patch-10
domtest.cl
----------------
patch-27
alle DOM Level 1 CORE Tests uebersetzen koennen (mehr schlecht als recht)
patch-28
so, jetzt kompilieren die DOM-Tests auch (wenngleich zwei drittel noch fehlschlagen)
patch-29
einzelnen Test ausfuehren koennen
patch-30
<length/> workaround
patch-31
<equals/> fuer nicht-Strings
patch-40
?
patch-42
implementationAttribute-Probleme zwar ausgeben, aber kein WARN machen
patch-53
domtest fixes fuer <var/> und <nodeType>
xmlconf.cl
----------------
patch-13
Testfunktion fuer XML Conformance Test Suite
patch-15
run only tests for namespace-aware XML-1.0 parsers
patch-16
mit korrektem OUTPUT abgleichen
<html>
<body>
<h1>Closure XML Parser</h1>
<p>An XML parser written in Common Lisp.</p>
<p>
Closure XML was written by <a
href="http://www.stud.uni-karlsruhe.de/~unk6/">Gilbert Baumann</a>
(unk6 at rz.uni-karlsruhe.de) as part of the Closure web
browser.<br>
Contributions to the parser by
<ul>
<li>
Henrik Motakef (hmot at henrik-motakef.de)<br>
(SAX layer; namespace support)
</li>
<li>
David Lichteblau at knowledgeTools &lt;david@knowledgetools.de&gt;<br>
(conversion into an independent package; DOM bug fixing)
</li>
</ul>
</p>
<p>
<h2>CXML Modules</h2>
CXML provides three packages:
<ul>
<li>
<tt>RUNES</tt>, a portable implementation of Unicode strings.
</li>
<li>
<tt>XML</tt>, a namespace-aware SAX parser implementing the <a
href="http://www.w3.org/TR/2000/REC-xml-20001006">XML 1.0
specification</a>.
</li>
<li>
<tt>DOM</tt>, an implementation of the <a
href="http://www.w3.org/TR/REC-DOM-Level-1/level-one-core.html">DOM
Level 1 Core</a> interfaces.
</li>
</ul>
</p>
<p>
<h2>Installation</h2>
<b>Prerequisites.</b> CXML is written in Common Lisp and should be
portable to all Common Lisp implementations.&nbsp; Currently known
to work are ACL, SBCL, CMUCL, and CLISP. (<i>fixme</i>: check
this list)
</p>
</p>
<a href="http://www.cliki.net/asdf">ASDF</a> is used for
compilation. These instructions assume that ASDF has already been
loaded. (Some Lisps include ASDF, for example SBCL and any Lisp
on Debian and Gentoo. For other Lisps please load asdf.lisp
manually before proceeding.)
</p>
<p>
<b>Configuration (optional).</b>
CXML has full Unicode code support -- even on Lisps without
Unicode strings. On non-unicode aware Lisps, <tt>DOMString</tt>
is implemented as an array of character codes. If your Lisp
supports 16 bit characters natively, you can enable feature
<tt>RUNE-IS-CHARACTER</tt> to select an alternative
<tt>DOMString</tt> implementatation, which uses real characters
instead of characters codes.
<pre> * (pushnew :rune-is-character *features*)</pre>
</p>
<p>
<b>Compiling and loading CXML.</b>
Register the .asd file, e.g. by symlinking it:
<pre> $ ln -sf `pwd`/cxms.asd /path/to/your/registry</pre>
Compile CXML using:
<pre> * (asdf:operate 'asdf:load-op :cxml)</pre>
</p>
<p>
<h2>Tests</h2>
Check out the XML and DOM testsuites:
<pre> $ export CVSROOT=:pserver:anonymous@dev.w3.org:/sources/public
$ cvs login # password is "anonymous"
$ cvs co 2001/XML-Test-Suite/xmlconf
$ cvs co 2001/DOM-Test-Suite</pre>
Run all applicable tests using:
<pre> * (xmlconf:run-all-tests "/path/to/2001/XML-Test-Suite/xmlconf/")
* (domtest:run-all-tests "/path/to/2001/2001/DOM-Test-Suite/")</pre>
(As always in Lisp, the trailing slash is significant.)
<p>
</p>
<i>fixme</i>: Add an explanation of xml/sax-tests here.
</p>
</body>
</html>
(defpackage :cxml-system
(:use :asdf :cl))
(in-package :cxml-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))
(call-next-method)))
(unless (find-package :glisp)
(defpackage :glisp))
(defsystem glisp
:default-component-class closure-source-file
:pathname (merge-pathnames
"glisp/"
(make-pathname :name nil :type nil :defaults *load-truename*))
:components
((:file dependent
:pathname
#+CLISP "dep-clisp"
#+(AND :CMU (NOT :PTHREAD)) "dep-cmucl"
#+sbcl "dep-sbcl"
#+(AND :CMU :PTHREAD) "dep-cmucl-dtc"
#+(and allegro allegro-v5.0) "dep-acl5"
#+(and allegro (not allegro-v5.0)) "dep-acl"
#+GCL "dep-gcl"
#-(or sbcl CLISP CMU allegro GCL) #.(error "Configure!"))
(:file "package"
:depends-on (dependent))
(:file "runes"
:depends-on ("package" dependent))
(:file "util"
:depends-on ("package" dependent "runes"))
(:file "match"
:depends-on ("package" dependent "runes" "util"))))
(asdf:defsystem :cxml
:default-component-class closure-source-file
:pathname (merge-pathnames
"cxml/"
(make-pathname :name nil :type nil :defaults *load-truename*))
:components
((:file "package")
(:file "encodings" :depends-on ("package"))
(:file "encodings-data" :depends-on ("package" "encodings"))
(:file "sax-handler")
(:file "dompack")
(:file "dom-impl" :depends-on ("dompack"))
(:file "dom-builder" :depends-on ("dom-impl" "sax-handler"))
(:file "xml-stream" :depends-on ("package"))
(:file "xml-name-rune-p" :depends-on ("package"))
(:file "xml-parse" :depends-on ("package" "dompack" "sax-handler"))
(:file "xml-canonic" :depends-on ("package" "dompack" "xml-parse")))
:depends-on (:glisp))
This diff is collapsed.
;;; XXX this DOM builder knows too much about the specifics of the DOM
;;; implementation for my taste. While document creation is not specified
;;; by the DOM Level 1 spec, we shouldn't really be manually setting slots
;;; in other nodes IMHO.
;;;
;;; As a follow-up to that, the children list is created in the wrong order
;;; and then reversed. Is it really worth the improved speed to do this?
;;; Calling APPEND-NODE would be portable.
;;;
;;; In particular, that design choice has lead to other bugs, for example the
;;; PARENT slot has to be set manually, too. A DOM test finally showed
;;; that this had been forgotten for Text nodes and PIs.
;;;
;;; Opinions?
;;;
;;; -- David
;;; Now at least the children list isn't reversed anymore, because I changed
;;; the representation to be an extensible vector. Still its not clear to
;;; me whether the DOM Builder should be affected by such changes at all.
;;;
;;; -- David
(in-package :dom-impl)
(defclass dom-builder ()
((document :initform nil :accessor document)
(element-stack :initform '() :accessor element-stack)))
(defun dom:make-dom-builder ()
(make-instance 'dom-builder))
(defun fast-push (new-element vector)
(vector-push-extend new-element vector (max 1 (array-dimension vector 0))))
(defmethod sax:start-document ((handler dom-builder))
(let ((document (make-instance 'dom-impl::document)))
(setf (slot-value document 'dom-impl::owner) nil
(slot-value document 'dom-impl::doc-type) nil)
(setf (document handler) document)
(push document (element-stack handler))))
(defmethod sax:end-document ((handler dom-builder))
(setf (slot-value (document handler) 'entities) xml::*entities*)
(let ((doctype (dom:doctype (document handler))))
(when doctype
(setf (slot-value (dom:entities doctype) 'read-only-p) t)
(setf (slot-value (dom:notations doctype) 'read-only-p) t)))
(document handler))
(defmethod sax:start-dtd ((handler dom-builder) name publicid systemid)
(declare (ignore publicid systemid))
(let* ((document (document handler))
(doctype (make-instance 'dom-impl::document-type
:name name
:notations (make-instance 'dom-impl::named-node-map
:element-type :notation
:owner document)
:entities (make-instance 'dom-impl::named-node-map
:element-type :entity
:owner document))))
(setf (slot-value doctype 'dom-impl::owner) document
(slot-value document 'dom-impl::doc-type) doctype)))
(defmethod sax:start-element ((handler dom-builder) namespace-uri local-name qname attributes)
(with-slots (document element-stack) handler
(let ((element (dom:create-element document qname))
(parent (car element-stack)))
(dolist (attr attributes)
(dom:set-attribute element (xml::attribute-qname attr) (xml::attribute-value attr)))
(setf (slot-value element 'dom-impl::parent) parent)
(fast-push element (slot-value parent 'dom-impl::children))
(push element element-stack))))
(defmethod sax:end-element ((handler dom-builder) namespace-uri local-name qname)
(pop (element-stack handler)))
(defmethod sax:characters ((handler dom-builder) data)
(with-slots (document element-stack) handler
(let* ((parent (car element-stack))
(last-child (dom:last-child parent)))
(cond
((eq (dom:node-type parent) :cdata-section)
(setf (dom:data parent) data))
((and last-child (eq (dom:node-type last-child) :text))
;; um entities herum wird SAX:CHARACTERS mehrfach aufgerufen fuer
;; den gleichen Textknoten. Hier muessen wir den bestehenden Knoten
;; erweitern, sonst ist das Dokument nicht normalisiert.
;; (XXX Oder sollte man besser den Parser entsprechend aendern?)
(dom:append-data last-child data))
(t
(let ((node (dom:create-text-node document data)))
(setf (slot-value node 'dom-impl::parent) parent)
(fast-push node (slot-value (car element-stack) 'dom-impl::children))))))))
(defmethod sax:start-cdata ((handler dom-builder))
(with-slots (document element-stack) handler
(let ((node (dom:create-cdata-section document #""))
(parent (car element-stack)))
(setf (slot-value node 'dom-impl::parent) parent)
(fast-push node (slot-value parent 'dom-impl::children))
(push node element-stack))))
(defmethod sax:end-cdata ((handler dom-builder))
(let ((node (pop (slot-value handler 'element-stack))))
(assert (eq (dom:node-type node) :cdata-section))))
(defmethod sax:processing-instruction ((handler dom-builder) target data)
(with-slots (document element-stack) handler
(let ((node (dom:create-processing-instruction document target data))
(parent (car element-stack)))
(setf (slot-value node 'dom-impl::parent) parent)
(fast-push node (slot-value (car element-stack) 'dom-impl::children)))))
(defmethod sax:comment ((handler dom-builder) data)
(with-slots (document element-stack) handler
(let ((node (dom:create-comment document data))
(parent (car element-stack)))
(setf (slot-value node 'dom-impl::parent) parent)
(fast-push node (slot-value (car element-stack) 'dom-impl::children)))))
(defmethod sax:unparsed-entity-declaration
((handler dom-builder) name public-id system-id notation-name)
(dom:set-named-item (dom:entities (dom:doctype (document handler)))
(make-instance 'dom-impl::entity
:owner (document handler)
:name name
:public-id public-id
:system-id system-id
:notation-name notation-name)))
(defmethod sax:notation-declaration
((handler dom-builder) name public-id system-id)
(dom:set-named-item (dom:notations (dom:doctype (document handler)))
(make-instance 'dom-impl::notation
:owner (document handler)
:name name
:public-id public-id
:system-id system-id)))
This diff is collapsed.
(in-package :dom-impl)
(defun dom:map-document
(handler document
&key (include-xmlns-attributes sax:*include-xmlns-attributes*)
include-default-values)
(sax:start-document handler)
(let ((doctype (dom:doctype document)))
(when doctype
(sax:start-dtd handler (dom:name doctype) nil nil)
(let ((ns (dom:notations doctype)))
(dotimes (k (dom:length ns))
(let ((n (dom:item ns k)))
(sax:notation-declaration handler
(dom:name n)
(dom:public-id n)
(dom:system-id n)))
;; fixme: entities!
)
(sax:end-dtd handler))))
(labels ((walk (node)
(dom:do-node-list (child (dom:child-nodes node))
(ecase (dom:node-type child)
(:element
;; fixme: namespaces
(let ((attlist
(compute-attributes child
include-xmlns-attributes
include-default-values))
(lname (dom:tag-name child))
(qname (dom:tag-name child)))
(sax:start-element handler nil lname qname attlist)
(walk child)
(sax:end-element handler nil lname qname)))
(:cdata-section
(sax:start-cdata handler)
(sax:characters handler (dom:data child))
(sax:end-cdata handler))
(:text
(sax:characters handler (dom:data child)))
(:comment
(sax:comment handler (dom:data child)))
(:processing-instruction
(sax:processing-instruction handler
(dom:target child)
(dom:data child)))))))
(walk document))
(sax:end-document handler))
(defun compute-attributes (element xmlnsp defaultp)
(let ((results '()))
(dom:do-node-list (a (dom:attributes element))
(when (and (or defaultp (dom:specified a))
(or xmlnsp (not (cxml::xmlns-attr-p (dom:name a)))))
(push
(cxml::make-attribute :qname (dom:name a)
:value (dom:value a)
:specified-p (dom:specified a))
results)))
(reverse results)))
(in-package :cl-user)
(defpackage :dom
(:use)
(:export
;; lisp-specific extensions
#:make-dom-builder
;; methods
#:has-feature
#:doctype
#:implementation
#:document-element
#:create-element
#:create-document-fragment
#:create-text-node
#:create-comment
#:create-cdata-section
#:create-processing-instruction
#:create-attribute
#:create-entity-reference
#:get-elements-by-tag-name
#:node-name
#:node-value
#:node-type
#:parent-node
#:child-nodes
#:first-child
#:last-child
#:previous-sibling
#:next-sibling
#:attributes
#:owner-document
#:insert-before
#:replace-child
#:remove-child
#:append-child
#:has-child-nodes
#:clone-node
#:item
#:length
#:get-named-item
#:set-named-item
#:remove-named-item
#:data
#:substring-data
#:append-data
#:insert-data
#:delete-data
#:replace-data
#:name
#:specified
#:value
#:tag-name
#:get-attribute
#:set-attribute
#:remove-attribute
#:get-attribute-node
#:set-attribute-node
#:remove-attribute-node
#:normalize
#:split-text
#:entities
#:notations
#:public-id
#:system-id
#:notation-name
#:target
#:import-node
#:code
;; protocol classes
#:dom-implementation
#:document-fragment
#:document
#:node
#:node-list
#:named-node-map
#:character-data
#:attr
#:element
#:text
#:comment
#:cdata-section
#:document-type
#:notation
#:entity
#:entity-reference
#:processing-instruction
;;
#:items
;;
#:node-p
#:document-p
#:document-fragment-p
#:character-data-p
#:attribute-p