Commit bc1347d2 authored by david's avatar david

Revision: cxml--devel--1.0--patch-43

Archive: david@knowledgetools.de--cxml
Creator: David Lichteblau <david@knowledgetools.de>
Date: Wed Feb  4 22:26:39 CET 2004
Standard-date: 2004-02-04 21:26:39 GMT
Modified-files: xml/dom-builder.lisp xml/dom-impl.lisp
    xml/xml-parse.lisp
New-patches: david@knowledgetools.de--cxml/cxml--devel--1.0--patch-43
Summary: hack: implemented CHILD-NODES for ENTITY-REFERENCE
Keywords:

Wir muessen die CHILD-NODES einer ENTITY-REFERENCE berechnen.
Allerdings alles noch etwas unausgereift.
  - Dazu die *ENTITIES* im Dokument vermerken...
  - und bei Bedarf parsen.

Ausserdem:
  - Die Entities muessen ausserdem mit EQUALP herausgesucht werden, denn sie
    sind ja durch rods benannt, daher reicht EQUAL nicht.
  - IMPORT-NODE fuer PROCESSING-INSTRUCTION korrigiert.
parent cc9b7803
......@@ -18,6 +18,7 @@
(defmethod sax:end-document ((handler dom-builder))
(setf (slot-value (document handler) 'children )
(nreverse (slot-value (document handler) 'children)))
(setf (slot-value (document handler) 'entities) xml::*entities*)
(document handler))
(defmethod sax:start-element ((handler dom-builder) namespace-uri local-name qname attributes)
......
......@@ -12,7 +12,8 @@
(owner :initarg :owner :initform nil)))
(defclass document (node)
((doc-type :initarg :doc-type :reader dom:doctype)))
((doc-type :initarg :doc-type :reader dom:doctype)
(entities :initform nil :reader entities)))
(defclass document-fragment (node)
())
......@@ -517,7 +518,15 @@
;;; DOCUMENT-TYPE -- missing
;;; NOTATION -- nix
;;; ENTITY -- nix
;;; ENTITY-REFERENCE -- nix
;;; ENTITY-REFERENCE
(defmethod initialize-instance :after ((instance entity-reference) &key)
(let* ((owner (dom:owner-document instance))
(entities (or (entities owner) xml::*entities*))
(children (xml::resolve-entity (dom:name instance) entities)))
(setf (slot-value instance 'children)
(mapcar (lambda (node) (dom:import-node owner node t)) children))))
;;; PROCESSING-INSTRUCTION
......@@ -626,10 +635,9 @@
(defmethod dom:import-node
((document document) (node processing-instruction) deep)
(import-node-internal 'notation document node deep
:name (dom:name node)
:public-id (dom:public-id node)
:system-id (dom:system-id node)))
(import-node-internal 'processing-instruction document node deep
:target (dom:target node)
:data (dom:data node)))
;; TEXT_NODE, CDATA_SECTION_NODE, COMMENT_NODE
(defmethod dom:import-node
......
......@@ -623,7 +623,7 @@
(defun entity->xstream (entity-name kind &optional zstream)
;; `zstream' is for error messages
(let ((looked (assoc (list kind entity-name) *entities* :test #'equal)))
(let ((looked (assoc (list kind entity-name) *entities* :test #'equalp)))
(unless looked
(if zstream
(perror zstream "Entity '~A' is not defined." (rod-string entity-name))
......@@ -643,7 +643,7 @@
r)))
(defun entity-source-kind (name type)
(let ((looked (assoc (list type name) *entities* :test #'equal)))
(let ((looked (assoc (list type name) *entities* :test #'equalp)))
(unless looked
(error "Entity '~A' is not defined." (rod-string name)))
(cadr looked)))
......@@ -2522,7 +2522,7 @@
res))))
(defun internal-entity-expansion (name)
(let ((e (assoc (list :general name) *entities* :test #'equal)))
(let ((e (assoc (list :general name) *entities* :test #'equalp)))
(unless e
(error "Entity '~A' is not defined." (rod-string name)))
(unless (eq :INTERNAL (cadr e))
......@@ -2574,10 +2574,12 @@
(lambda (zinput)
(muffle (car (zstream-input-stack zinput))))) ))))
#+(or) ;; Do we need this? Not called anywhere
;; Do we need this? Not called anywhere --?
;; Used by dom-impl.lisp now, but wih a huge FIXME. See below. --david
(defun ff (name)
(let ((input (make-zstream)))
(let ((*data-behaviour* :DOC)
#+(or) ;?
(*document* (make-instance 'simple-document)))
(recurse-on-entity
input name :general
......@@ -2589,6 +2591,17 @@
(unless (eq (peek-token input) :eof)
(error "Trailing garbage. - ~S" (peek-token input)))))))))
;;; XXX FIXME
(defun resolve-entity (name entities)
(let ((*handler* (make-instance 'dom-impl::dom-builder))
(*namespace-bindings* *default-namespace-bindings*)
(*entities* entities)
(*dtd* (make-dtd)))
(declare (special *namespace-bindings*)) ;forward declaration for DEFVAR
(sax:start-document *handler*)
(ff (rod name))
(dom:child-nodes (sax:end-document *handler*))))
(defun read-att-value-2 (input)
(let ((delim (read-rune input)))
(unless (member delim '(#/\" #/\') :test #'eql)
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment