; Location = (make-location Nat Nat) | Symbol (define-record-type location :location (make-location line char offset) location? (line location-line) (char location-char) (offset location-offset)) ;; Source ::= (make-source Location Location) (define-record-type source :source (make-source start stop) really-source? (start really-source-start) (stop really-source-stop)) (define (source-start obj) (cond ((element? obj) (element-start obj)) ((attribute? obj) (attribute-start obj)) ((pcdata? obj) (pcdata-start obj)) ((entity? obj) (entity-start obj)) ((pi? obj) (pi-start obj)) ((start-tag? obj) (start-tag-start obj)) ((end-tag? obj) (end-tag-start obj)) (else (really-source-start obj)))) (define (source-stop obj) (cond ((element? obj) (element-stop obj)) ((attribute? obj) (attribute-stop obj)) ((pcdata? obj) (pcdata-stop obj)) ((entity? obj) (entity-stop obj)) ((pi? obj) (pi-stop obj)) ((start-tag? obj) (start-tag-stop obj)) ((end-tag? obj) (end-tag-stop obj)) (else (really-source-stop obj)))) (define (does-any-satisfy? preds obj) (if (null? preds) #f (or ((car preds) obj) (does-any-satisfy? (cdr preds) obj)))) (define (source? obj) (does-any-satisfy? (list really-source? element? attribute? pcdata? entity? pi? start-tag? end-tag?) obj)) ;; Document ::= (make-document Prolog Element (listof Misc)) (define-record-type document :document (make-document prolog element misc) document? (prolog document-prolog) (element document-element) (misc document-misc)) ; Prolog = (make-prolog (listof Misc) Document-type [Misc ...]) ; The Misc items after the Document-type are optional arguments to maintain ; backward compatability with older versions of the XML library. ;(define-struct prolog (misc dtd misc2)) (define-record-type prolog :prolog (really-make-prolog misc dtd misc2) prolog? (misc prolog-misc) (dtd prolog-dtd) (misc2 prolog-misc2)) (define (make-prolog misc dtd . misc2) (really-make-prolog misc dtd misc2)) ;;; Document-type = (make-document-type sym External-dtd #f) ;;; | #f (define-record-type document-type :document-type (make-document-type name external inlined) really-document-type? (name document-type-name) (external document-type-external) (inlined document-type-inlined)) ;;; External-dtd = (make-external-dtd/public str str) ;;; | (make-external-dtd/system str) ;;; | #f (define-record-type external-dtd :external-dtd (make-external-dtd system) really-external-dtd? (system really-external-dtd-system)) (define (external-dtd-system external-dtd) (cond ((really-external-dtd? external-dtd) (really-external-dtd-system external-dtd)) ((external-dtd/public? external-dtd) (external-dtd/public-system external-dtd)) ((external-dtd/system? external-dtd) (external-dtd/system-system external-dtd)) (else (error "bottom of external-dtd-system" external-dtd)))) (define (external-dtd? obj) (does-any-satisfy? (list really-external-dtd? external-dtd/public? external-dtd/system?) obj)) (define-record-type external-dtd/public :external-dtd/public (make-external-dtd/public system public) external-dtd/public? (system external-dtd/public-system) (public external-dtd/public-public)) (define-record-type external-dtd/system :external-dtd/system (make-external-dtd/system system) external-dtd/system? (system external-dtd/system-system)) ;; Element ::= (make-element Location Location Symbol (listof Attribute) (listof Content)) (define-record-type element :element (make-element start stop name attributes content) element? (start element-start) (stop element-stop) (name element-name) (attributes element-attributes) (content element-content)) ;; Attribute ::= (make-attribute Location Location Symbol String) (define-record-type attribute :attribute (make-attribute start stop name value) attribute? (start attribute-start) (stop attribute-stop) (name attribute-name) (value attribute-value)) ;; Pcdata ::= (make-pcdata Location Location String) (define-record-type pcdata :pcdata (make-pcdata start stop string) pcdata? (start pcdata-start) (stop pcdata-stop) (string pcdata-string)) ;; Content ::= Pcdata ;; | Element ;; | Entity ;; | Misc ;; Misc ::= Comment ;; | Processing-instruction ;; Entity ::= (make-entity Location Location (U Nat Symbol)) (define-record-type entity :entity (make-entity start stop text) entity? (start entity-start) (stop entity-stop) (text entity-text)) ;; Processing-instruction ::= (make-pi Location Location String (list String)) ;; also represents XMLDecl (define-record-type pi :pi (make-pi start stop target-name instruction) pi? (start pi-start) (stop pi-stop) (target-name pi-target-name) (instruction pi-instruction)) ;; Comment ::= (make-comment String) (define-record-type comment :comment (make-comment text) comment? (text comment-text)) ;; content? : TST -> Bool (define (content? x) (or (pcdata? x) (element? x) (entity? x) (comment? x) (pi? x))) ;;; moved here from reader as it inherits from source ;; Start-tag ::= (make-start-tag Location Location Symbol (listof Attribute)) (define-record-type start-tag :start-tag (make-start-tag start stop name attrs) start-tag? (start start-tag-start) (stop start-tag-stop) (name start-tag-name) (attrs start-tag-attrs)) ;; End-tag ::= (make-end-tag Location Location Symbol) (define-record-type end-tag :end-tag (make-end-tag start stop name) end-tag? (start end-tag-start) (stop end-tag-stop) (name end-tag-name))