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 @@ ...@@ -18,6 +18,7 @@
(defmethod sax:end-document ((handler dom-builder)) (defmethod sax:end-document ((handler dom-builder))
(setf (slot-value (document handler) 'children ) (setf (slot-value (document handler) 'children )
(nreverse (slot-value (document handler) 'children))) (nreverse (slot-value (document handler) 'children)))
(setf (slot-value (document handler) 'entities) xml::*entities*)
(document handler)) (document handler))
(defmethod sax:start-element ((handler dom-builder) namespace-uri local-name qname attributes) (defmethod sax:start-element ((handler dom-builder) namespace-uri local-name qname attributes)
......
...@@ -12,7 +12,8 @@ ...@@ -12,7 +12,8 @@
(owner :initarg :owner :initform nil))) (owner :initarg :owner :initform nil)))
(defclass document (node) (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) (defclass document-fragment (node)
()) ())
...@@ -517,7 +518,15 @@ ...@@ -517,7 +518,15 @@
;;; DOCUMENT-TYPE -- missing ;;; DOCUMENT-TYPE -- missing
;;; NOTATION -- nix ;;; NOTATION -- nix
;;; ENTITY -- 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 ;;; PROCESSING-INSTRUCTION
...@@ -626,10 +635,9 @@ ...@@ -626,10 +635,9 @@
(defmethod dom:import-node (defmethod dom:import-node
((document document) (node processing-instruction) deep) ((document document) (node processing-instruction) deep)
(import-node-internal 'notation document node deep (import-node-internal 'processing-instruction document node deep
:name (dom:name node) :target (dom:target node)
:public-id (dom:public-id node) :data (dom:data node)))
:system-id (dom:system-id node)))
;; TEXT_NODE, CDATA_SECTION_NODE, COMMENT_NODE ;; TEXT_NODE, CDATA_SECTION_NODE, COMMENT_NODE
(defmethod dom:import-node (defmethod dom:import-node
......
...@@ -623,7 +623,7 @@ ...@@ -623,7 +623,7 @@
(defun entity->xstream (entity-name kind &optional zstream) (defun entity->xstream (entity-name kind &optional zstream)
;; `zstream' is for error messages ;; `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 (unless looked
(if zstream (if zstream
(perror zstream "Entity '~A' is not defined." (rod-string entity-name)) (perror zstream "Entity '~A' is not defined." (rod-string entity-name))
...@@ -643,7 +643,7 @@ ...@@ -643,7 +643,7 @@
r))) r)))
(defun entity-source-kind (name type) (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 (unless looked
(error "Entity '~A' is not defined." (rod-string name))) (error "Entity '~A' is not defined." (rod-string name)))
(cadr looked))) (cadr looked)))
...@@ -2522,7 +2522,7 @@ ...@@ -2522,7 +2522,7 @@
res)))) res))))
(defun internal-entity-expansion (name) (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 (unless e
(error "Entity '~A' is not defined." (rod-string name))) (error "Entity '~A' is not defined." (rod-string name)))
(unless (eq :INTERNAL (cadr e)) (unless (eq :INTERNAL (cadr e))
...@@ -2574,10 +2574,12 @@ ...@@ -2574,10 +2574,12 @@
(lambda (zinput) (lambda (zinput)
(muffle (car (zstream-input-stack 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) (defun ff (name)
(let ((input (make-zstream))) (let ((input (make-zstream)))
(let ((*data-behaviour* :DOC) (let ((*data-behaviour* :DOC)
#+(or) ;?
(*document* (make-instance 'simple-document))) (*document* (make-instance 'simple-document)))
(recurse-on-entity (recurse-on-entity
input name :general input name :general
...@@ -2589,6 +2591,17 @@ ...@@ -2589,6 +2591,17 @@
(unless (eq (peek-token input) :eof) (unless (eq (peek-token input) :eof)
(error "Trailing garbage. - ~S" (peek-token input))))))))) (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) (defun read-att-value-2 (input)
(let ((delim (read-rune input))) (let ((delim (read-rune input)))
(unless (member delim '(#/\" #/\') :test #'eql) (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