doc-set = (list doc doc ...) doc - an SXML document Each document contains uri-, id- and xlink- auxiliary subtrees: doc = `(*TOP* (@@ (uri ,uri-string) (id-index . ,id-index) (sxlink (traversal-info ,one-to-many-traverse ,one-to-many-traverse ...) (roles ,role-info ,role-info ...) (arcroles ,arcrole-info ,arcrole-info ...)) ...) ...) id-index = (list (cons id element) (cons id element) ...) one-to-many-traverse = = (list uri linkbase fragment role position element single-traverse single-traverse ... single-traverse) single-traverse = (list uri fragment role position element arcrole show actuate) role-info = (list role position element) arcrole-info = (list arcrole position element) uri-string - a string representing a uri of the document id - (a string) element's unique ID element - an SXML presentation of an element uri - can be 1) a string representing a Unified Resource Identifier of a resource participating in a link, or 2) #f, if this resource resides in the same document as a currently processed one linkbase - a boolean value: whether this uri is an XLink linkbase fragment - a fragment within a resource defined by the uri. Fragment can be 1) An SXML presentation of the element (when the resource is a local one, defined by a 'resource' or 'simple' XLink elements; uri=#f in that case), 2) A string representing an XPointer-defined location, or 3) #f if the whole resource defined by the uri participates in a link role - a string representing an xlink:role, or #f if this attribute was not supplied for that resource position - a number. It is a position within the document where the declaration of this resource took place element - an SXML presentation of an element where the declaration of this resource took place single-traverse - a traversal that can be initiated from that resource. There can be no 'single-traverse's for a 'one-to-many-traverse' if no traversal can be initiated (i.e. no arc starts from that resource) arcrole - a string representing a role of the are, or #f if an xlink:arcrole attribute wasn't supplied for this arc show - a string representing the value of xlink:show attribute, or #f if this attribute was omitted actuate - the same for an xlink:actuate attribute
Given a document, the function returns its 'uri-string' #f is returned if there is no "@@/uri" subtree in the document
This function inserts a uri auxiliary subtree with a 'uri-string' If the 'doc' already contains such a subtree, an old uri-string will be replaced be the new one. Other subtrees in an auxiliary list are not modified The new 'doc' is returned
This function returns a document's 'id-index' #f is returned is there is no "@@/id-index" subtree in the document
This function returns document's 'traversal-info' #f is returned is there is no "@@/sxlink/traversal-info" subtree
This function returns document's 'roles' #f is returned is there is no "@@/sxlink/roles" subtree in the document
This function returns document's 'roles' #f is returned is there is no "@@/sxlink/arcroles" subtree in the document
This function returns both document's 'roles' and 'arcroles' #f is returned is there is no "@@/sxlink/(roles | arcroles)" subtree in the document.
uri-list = (list uri-string uri-string ...) uri-string - a string representing the uri of a resource
The function returns the list of loaded document's uris
The function returns a list of URIs which are refered by XLink markup Result: uri-list The list may contain duplicates.
The function returns a list of linkbases' uris which are refered by XLink markup Result: uri-list The list may contain duplicates.
Finding a document in 'doc-set' by its 'uri-string' If there is no such document, #f is returned
The function loads one or more XML documents Arguments: one or more 'uri-string's. Each of them locates a resource Result: 'doc-set'
This function recursively loads all linkbases which are refered by XLink markup in 'doc-set' "Recursively" means that if a loaded linkbase refers to another linkbase, the latter one will be loaded either, and so on. 'max-steps' argument, if presented, limits the maximum number of steps in a "chain" of linkbases. If curcular references occur, this situation is discovered Result: a 'doc-set' which contains all documents from the source 'doc-set' plus all loaded linkbase documents
This function recursively loads all documents (resources) which are refered by XLink markup in 'doc-set' "Recursively" means that if a loaded document refers to another document, the latter one will be loaded either, and so on. 'max-steps' argument, if presented, limits the maximum number of steps in a "chain" of documents. If curcular references occur, this situation is discovered. Result: a 'doc-set' which contains documents from the source 'doc-set' plus all loaded documents
sorted-traversal-info = (list uri-related-traverses uri-related-traverses ...) uri-related-traverses = (list uri linkbase uri-related-one-to-many ... uri-related-one-to-many) uri-related-one-to-many = (list fragment role uri-where-declared position element single-traverse single-traverse ... single-traverse) uri - is always a string (cannot be #f) uri-where-declared - a uri of the resource where the declaration took place linkbase, fragment, role, position, element, single-traverse - see the comment for "Loaded documents" section
Accessors for 'uri-related-traverses'
Mutator for 'uri-related-traverses' list-uri-related-one-to-many = (list uri-related-one-to-many uri-related-one-to-many ...)
Accessors for 'uri-related-one-to-many'
Mutator for 'uri-related-one-to-many' single-traverses = (list single-traverse single-traverse ...)
Given 'doc-set' the function constructs 'sorted-traversal-info'
Unite two or more 'sorted-traversal-info's
This function checks the validity of all resource references contained in 'sorted-traversal-info' If everything is ok, #t is returned. Otherwise, function returns #f and error messages are displayed as a side effect.
sorted-roles = (list role-related-info role-related-info ...) role-related-info = (list role single-declaration ... single-declaration) role - a string representing a role (or an arcrole) single-declaration = (list uri-where-declared position element) uri-where-declared, position, element - a location where this role was declared
Mutator for a 'role-related-info'
Accessors for 'single-declaration'
Mutator for 'role-info'
Given 'doc-set' the function constructs 'sorted-roles' accessor = xlink:roles | xlink:arcroles | xlink:roles+arcroles accessor returns document's 'roles' and/or 'arcroles'
Unite two or more 'sorted-roles'
This function checks the validity of all role references contained in 'sorted-roles' If everything is ok, #t is returned. Otherwise, function returns #f and error messages are displayed as a side effect.
A "resolved" subtree within an "sxlink" auxiliary list: doc = `(*TOP* (@@ (sxlink (resolved ,resolved-traverse ,resolved-traverse ...) ...) ...) ...) resolved-traverse = uri-related-one-to-many uri-related-one-to-many - see a comment for the 'sorted-roles' datatype. The only difference with the 'sorted-roles' datatype is that 'fragment' is always an SXML presentation of the element within a 'doc'. There may be multiple resolved-traverses with an equivalent 'fragment'.
This function returns document's resolved-traverses #f is returned is there is no "@@/sxlink/resolved" subtree in the document
This function chooses traverses related to the 'doc', dereferences all XPointer identifiers (i.e. transforms all locators into local resource fragments) and constructs an "sxlink/resolved" auxiliary subtree. A new 'doc' is returned. If an XPointer identifier points to a nodeset consisting of more than one node, several one-to-many traverses are constructed. If an "@@/sxlink/resolved" list is already presented in a document, it will be replaced.
They test whether an SXML node has a definite XLink type ATTENTION: 1. A non-prefixed XLink namespace uri is used for this node tests. If a prefix is used, this functions are incorrect. 2. These predicates should be used carefully - element's XLink-related meaning depends not only on its xlink:type attribute, but also on its position among other XLink element. For example, an element with an xlink:type="arc" attribute is not an arc element if it has anything other then an extended-link element as a parent
This is a helper function. type - a string, is supposed to have one of the following values: "extended", "simple", "locator", "resource", "arc", "title". A function is returned. When applied to an SXML node, it determines whether the node's xlink:type attribute has a 'type' value.
Node tests for different XLink elements
The idea of this operation is taken from X2X processor. Document's nodes serving for starting resources in some traversals, are replaced with (transformed) ending resources. A single node may be a starting resource for multiple traverses: possible-traverses = (list possible-traverse possible-traverse ...) possible-traverse = (list uri fragment arcrole show actuate) uri, arcrole, show, actuate - see a comment in "A list of loaded SXML documents" section fragment - a dereferenced ending resource. Fragment's possible value types: 1. A string - the whole ending resource, when it is not an XML document; 2. An SXML element - the fragment is either as a local resource, or it is the root node of the document (when XPointer identifier is omitted); 3. A nodeset - when the fragment is defined by XPointer identifier. The order of elements in 'possible-traverses' is undefined
Accessors for a 'possible-traverse'
A mutator for a 'possible-traverse'
(lambda (start-node possible-traverses) ...) start-node - the node in a document which serves for a starting resource possible-traverses - traverses that are defined for that node. This is always a non-empty list. Handler specifies the node inclusion operation for this 'start-node' - this depends on handler's result: 1. A new SXML node. The 'start-node' will be replaced by the new node. 2. A (sorted) nodeset. The 'start-node' will be replaced by multiple nodes, in the same order in which they appear in a nodeset. If a nodeset is emply, a 'start-node' is removed from the resulting document and nothing is inserted instead. Some basic inclusion handlers are supplied for this API, although user shoild feel free to introduce his own handlers
This handler returns an ending resorce. If more than one traversals are possible, one of them is chosen. No order is specified for 'possible-traverses', so it is not advised to use this handler if multiple traverses are defined for some starting resource. (nih is short for "Node Inclusion Handler")
Given a 'filter-pred?' this function returns an inclusion handler filter-pred? = (lambda (possible-traverse) ...) 'possible-traverses' are filtered with a 'filter-pred'. Three situations: 1. If a filtered list is empty, the 'start-node' remains unchanged; 2. If a filtered list contains exactly one traverse, its ending resource is returned; 3. Otherwise, one traverse is chosen. Its ending resource is returned. If given a filter-pred? = (lambda (possible-traverse) #t) this function becomes an 'xlink:nih-ending-resource' handler.
This handler simply removes a 'start-node' without inserting anything instead.
When performing node inclusion, it may be necessary to remove XLink-related elements from a resulting document. A simple-link element is itself a starting resource for a traverse, so it is processed by inclusion handlers. As for extended-link element (and its content), it doesn't generally serve for a starting resource. That's why handler tools are introduced for processing an extended link. The extended link handler (we will abbreviate this with elh) looks as follows: (lambda (extended-element) ...) extended-element - an element node for an extended link element The handler's result must be one of the following 1. A new SXML node. The 'extended-element' will be replaced by the new node 2. A (sorted) nodeset. The 'extended-element' will be replaced by multiple nodes, in the same order in which they appear in a nodeset. If a nodeset is emply, an 'extended-element' is removed from the resulting document and nothing is inserted instead. Some basic extended link handlers are supplied for this API, although user shoild feel free to introduce his own handlers
This handler keeps an 'extended-element' unchanged
This handler completely removes an 'extended-element' from a resulting document (together with all its descendants)
The handler removes only those elements which have an XLink-related meaning (i.e. an extended link element; its locator-, resource-, are- and title- children; locator's and arc's title- children). Their child elements are combined into a nodeset, which is returned as a result ATTENTION: It is theoretically possible that some non-XLink descendant elements become XLink elements after such a transformation (for example, a nested element with an xlink:type="simple" or "extended"). That's why this handler should be used carefully
This handler removes an xlink:type attribute from an 'extended-element'. An 'extended-element' in not an XLink element after such a transformation; all its locator-, resource-, arc- and title- child elements are not XLink elements too then. ATTENTION: It is theoretically possible that some non-XLink descendant elements become XLink elements after such a transformation (for example, a nested element with an xlink:type="simple" or "extended"). That's why this handler should be used carefully.
When performing node inclusion, it may be necessary to process auxiliary lists of a document. For example, some aux list members containing Scheme pointers (an id-index, XLink traversal info, parent references, etc.) become invalid in a resulting document. That' s because node inclusion operation constructs an absolutely new document. The auxiliary list handler (alh) looks as follows: (lambda (auxiliary-list) ...) auxiliary-list = '(@@ .....) The handler's result must be one of the following 1. A new SXML node. The 'auxiliary-list' will be replaced by the new node 2. A (sorted) nodeset. The 'auxiliary-list' will be replaced by multiple nodes, in the same order in which they appear in a nodeset. If a nodeset is emply, an 'auxiliary-list' is removed from the resulting document. Two trivial auxiliary list handlers are supplied for this API. User shoild feel free to introduce his own handlers
This handler keeps an 'auxiliary-list' unchanged
This handler completely removes an 'auxiliary-list' from a resulting document (together with all its descendants)
This function implement a node inclusion operation (see a comment at the beginning of this chapter) dereferenced-doc - a document to which an 'xlink:xpointer-dereference' operation has been applied (i.e. it contains an "@@/sxlink/resolved" subtree ni-handler - a node inclusion handler (see "Inclusion handlers" section) el-handler - an extended-link handler (see "Transforming extended link elements" section) al-handler - an auxiliary list handler (see "Transforming an auxiliary list" section) A document with replaced nodes is returned.
The idea of this operation is taken from X2X processor. For any specified traversal with the starting resource residing in a current document, this traversal is rewritten as an outbound link (i.e. a link defined in a current document, with a starting resource as a local one). After such a transformation, the document becomes independent from linkbases (by the way, this is an XTooX' functionality). Similarily to node inclusion, a single node may be a starting resource for multiple traverses: possible-traverses = (list possible-traverse possible-traverse ...) possible-traverse = (list uri fragment arcrole show actuate) This datatype was introduced in "Node inclusion chapter". The only difference is that a 'fragment' cannot be a local resource here - it is either a string representing an XPointer identifier or #f (an unfragmented resource serves for the end of the traversal).
(lambda (start-node possible-traverses) ...) start-node - the node in a document which serves for a starting resource possible-traverses - traverses that are defined for that node. This is always a non-empty list. Handler should return a linking element that would specify outbound traverses from a 'start-node'. Similarly to node inclusion operation, the following datatypes are expected for a handler's result 1. A new SXML node. The 'start-node' will be replaced by the new node. or 2. A (sorted) nodeset. The 'start-node' will be replaced by multiple nodes, in the same order in which they appear in a nodeset. If a nodeset is emply, a 'start-node' is removed from the resulting document and nothing is inserted instead. Some basic link resolution handlers are supplied for this API, although user shoild feel free to introduce his own handlers
This handler constructs a simple-link element If a 'start-node' is already a simple link element, it is not modified. If more than one traversals are possible, one of them is chosen. No order is specified for 'possible-traverses', so it is not advised to use this handler if multiple traverses are defined for some starting resource. (lrh is short for Link Resolution Handler)
This handler constructs an extended-link element with a 'start-node' as a resource-element, and 'possible traverses' as several locator- and outbound arc- elements.
This is a combination of two previous handlers. If 'possible-traverses' consists of exactly one element, a simple-link element is constructed. Otherwise an extended-link element is constructed.
This function returns an XPointer analog for an XLink local resource. Thus a local resource is always an element, an XPointer identifier can be constructed as a ChildSequence, i.e. "/m/n/k" node - a local resource's node doc - an SXML document A string representing an XPointer identifier is returned on success. In case of an error (a 'node' cannot be found within a 'doc') #f is returned.
This function implement a link resolution operation (see a comment at the beginning of this chapter) dereferenced-doc - a document to which an 'xlink:xpointer-dereference' operation has been applied (i.e. it contains an "@@/sxlink/resolved" subtree lr-handler - a link resolution handler (see "Link resolution handlers" section) el-handler - an extended-link handler (see "Transforming extended link elements" section) al-handler - an auxiliary list handler (see "Transforming an auxiliary list" section) A new document is returned
Given zero or more option parameters, the function returns another function: (lambda (uri-string . uri-strings) ...) Arguments for this returned function - one or more strings representing XML document's uris. These documents are parsed in accordance with XLink specification. XLink validation is performed for them: 1. Remote resources participating in XLink-defined traversals are checked; 2. If requested by options, roles and/or arcroles are checked either; 3. If requested by options, linkbases and/or documents which are refered by XLink markup are loaded recursively (and validation is performed for them as well). Boolean #t is returned if everything is valid in accordance with XLink (although some warning messages can be displayed as a side effect). Otherwise #f is returned and message diagnostics is displayed. Option parameters are the following: 'linkbases - recursively load linkbases which are refered by XLink markup 'docs - recursively load documents which are refered by XLink markup 'roles - check roles' validity 'arcroles - check arcroles' validity
This function performs a node inclusion operation. uri-string - XML document's uri. Linkbases are loaded resursively. ni-handler - a Node Inclusion handler. See "Inclusion handlers" section for details. el-handler - an Extended Link element handler. See "Transforming extended link elements" section for details. al-handler - an Auxiliary List handler. See "Transforming auxiliary list" section for details. A document with replaced nodes is returned. See also - "Node inclusion" chapter.
This function performs a link resolution operation. uri-string - XML document's uri. Linkbases are loaded resursively. lr-handler - a Link Resolution handler. See "Link resolution handlers" section for details. el-handler - an Extended Link element handler. See "Transforming extended link elements" section for details. al-handler - an Auxiliary List handler. See "Transforming auxiliary list" section for details. A new document is returned. See also - "Link resolution" chapter.
This function returns document's resolved-traverses #f is returned is there is no "@@/sxlink/resolved" subtree in the document
(define (xlink:resolved doc)
(let((nodeset ((sxpath '(@@ sxlink resolved)) doc)))
(if(null? nodeset) ; there is no "@@/sxlink/resolved" subtree
#f
(cdar nodeset))))
This function chooses traverses related to the 'doc', dereferences all XPointer identifiers (i.e. transforms all locators into local resource fragments) and constructs an "sxlink/resolved" auxiliary subtree. A new 'doc' is returned. If an XPointer identifier points to a nodeset consisting of more than one node, several one-to-many traverses are constructed. If an "@@/sxlink/resolved" list is already presented in a document, it will be replaced.
(define (xlink:xpointer-dereference sorted-traversal-info doc)
(let((sxlink-subtrees
((select-kids
(lambda (node)
(not (and (pair? node) (equal? (car node) 'resolved)))))
((select-kids (ntype?? 'sxlink))
((select-kids (ntype?? '@@))
doc))))
(aux-subtrees
((select-kids
(lambda (node)
(not (and (pair? node) (equal? (car node) 'sxlink)))))
((select-kids (ntype?? '@@))
doc)))
(kids
((select-kids
(lambda (node)
(not (and (pair? node) (equal? (car node) '@@)))))
doc))
(doc-uri (xlink:uri doc))
(id-index (cond
((xlink:id-index doc)
=> (lambda (x) x))
(else '()))))
(if
(not doc-uri) ; an error situation
(cons* '*TOP*
(cons* '@@
(cons* 'sxlink (list 'resolved) sxlink-subtrees)
aux-subtrees)
kids)
(let loop ((one-to-many-traverses
(cond
((assoc doc-uri sorted-traversal-info)
=> xlink:uri-traverses-one-to-many)
(else '())))
(resolved '()))
(if
(null? one-to-many-traverses)
(cons* '*TOP*
(cons* '@@
(cons* 'sxlink
(cons 'resolved resolved)
sxlink-subtrees)
aux-subtrees)
kids)
(let*((uri-one-to-many (car one-to-many-traverses))
(fragment (car uri-one-to-many)))
(cond
((not fragment) ; a root element of the document
(let((root-el ((select-kids (ntype?? '*)) doc)))
(if
(null? root-el) ; strange...
(loop
(cdr one-to-many-traverses)
resolved)
(loop
(cdr one-to-many-traverses)
(cons
(cons (car root-el) (cdr uri-one-to-many))
resolved)))))
((pair? fragment) ; a local resource already
(loop
(cdr one-to-many-traverses)
(cons uri-one-to-many resolved)))
(else ; it is a string representing XPointer identifier
(let((func (sxp:xpointer fragment)))
(cond
((not func) ; parser error
(cerr
nl (xlink:uri-one-to-many-uri uri-one-to-many)
", position "
(xlink:uri-one-to-many-position uri-one-to-many)
": incorrect XPointer identifier - " fragment nl)
(loop
(cdr one-to-many-traverses)
resolved))
(else
(let((nset (func doc id-index)))
(cond
((or (null? nset) (not (nodeset? nset)))
(cerr
nl (xlink:uri-one-to-many-uri uri-one-to-many)
", position "
(xlink:uri-one-to-many-position uri-one-to-many)
": an XPointer identifier doesn't point"
" to any location - " fragment nl)
(loop
(cdr one-to-many-traverses)
resolved))
(else
(loop
(cdr one-to-many-traverses)
(append
(map
(lambda (node)
(cons node (cdr uri-one-to-many)))
nset)
resolved))))))))))))))))
This is a helper function. type - a string, is supposed to have one of the following values: "extended", "simple", "locator", "resource", "arc", "title". A function is returned. When applied to an SXML node, it determines whether the node's xlink:type attribute has a 'type' value.
(define (xlink:ntype?? type)
(lambda (node)
(let((attval
((select-kids (ntype?? '*text*))
((select-kids (ntype?? 'http://www.w3.org/1999/xlink:type))
((select-kids (ntype?? '@)) node)))))
(if(null? attval) ; there is no xlink:type attribute
#f
(string=? (car attval) type)))))
Node tests for different XLink elements
(define xlink:extended? (xlink:ntype?? "extended"))
(define xlink:simple? (xlink:ntype?? "simple"))
(define xlink:locator? (xlink:ntype?? "locator"))
(define xlink:resource? (xlink:ntype?? "resource"))
(define xlink:arc? (xlink:ntype?? "arc"))
(define xlink:title? (xlink:ntype?? "title"))
Given zero or more option parameters, the function returns another function: (lambda (uri-string . uri-strings) ...) Arguments for this returned function - one or more strings representing XML document's uris. These documents are parsed in accordance with XLink specification. XLink validation is performed for them: 1. Remote resources participating in XLink-defined traversals are checked; 2. If requested by options, roles and/or arcroles are checked either; 3. If requested by options, linkbases and/or documents which are refered by XLink markup are loaded recursively (and validation is performed for them as well). Boolean #t is returned if everything is valid in accordance with XLink (although some warning messages can be displayed as a side effect). Otherwise #f is returned and message diagnostics is displayed. Option parameters are the following: 'linkbases - recursively load linkbases which are refered by XLink markup 'docs - recursively load documents which are refered by XLink markup 'roles - check roles' validity 'arcroles - check arcroles' validity
(define (xlink:validator . options)
(let((recursive
(cond
((member 'docs options) xlink:load-docs-recursively)
((member 'linkbases options) xlink:load-linkbases-recursively)
(else (lambda (x) x))))
(accessor
(cond
((member 'roles options)
(if(member 'arcroles options)
xlink:roles+arcroles
xlink:roles))
((member 'arcroles options) xlink:arcroles)
(else #f))))
(if
(not accessor) ; no roles should be checked
(lambda (uri-string . uri-strings)
(let((doc-set
(recursive
(apply xlink:load-docs (cons uri-string uri-strings)))))
(xlink:validate-resources
(xlink:doc-set->sorted-traversal doc-set)
doc-set)))
(lambda (uri-string . uri-strings)
(let((doc-set
(recursive
(apply xlink:load-docs (cons uri-string uri-strings)))))
(let((ok1
(xlink:validate-resources
(xlink:doc-set->sorted-traversal doc-set)
doc-set))
(ok2
(xlink:validate-roles
(xlink:doc-set->sorted-roles doc-set accessor))))
(and ok1 ok2)))))))
This function performs a node inclusion operation. uri-string - XML document's uri. Linkbases are loaded resursively. ni-handler - a Node Inclusion handler. See "Inclusion handlers" section for details. el-handler - an Extended Link element handler. See "Transforming extended link elements" section for details. al-handler - an Auxiliary List handler. See "Transforming auxiliary list" section for details. A document with replaced nodes is returned. See also - "Node inclusion" chapter.
(define (xlink:node-inclusion uri-string ni-handler el-handler al-handler)
(let((doc-set (xlink:load-linkbases-recursively
(xlink:load-docs uri-string))))
(let((dereferenced-doc (xlink:xpointer-dereference
(xlink:doc-set->sorted-traversal doc-set)
(xlink:find-doc uri-string doc-set))))
(xlink:include-nodes dereferenced-doc doc-set
ni-handler el-handler al-handler))))
This function performs a link resolution operation. uri-string - XML document's uri. Linkbases are loaded resursively. lr-handler - a Link Resolution handler. See "Link resolution handlers" section for details. el-handler - an Extended Link element handler. See "Transforming extended link elements" section for details. al-handler - an Auxiliary List handler. See "Transforming auxiliary list" section for details. A new document is returned. See also - "Link resolution" chapter.
(define (xlink:link-resolution uri-string lr-handler el-handler al-handler)
(let((doc-set (xlink:load-linkbases-recursively
(xlink:load-docs uri-string))))
(let((dereferenced-doc (xlink:xpointer-dereference
(xlink:doc-set->sorted-traversal doc-set)
(xlink:find-doc uri-string doc-set))))
(xlink:resolve-links dereferenced-doc doc-set
lr-handler el-handler al-handler))))
Given a document, the function returns its 'uri-string' #f is returned if there is no "@@/uri" subtree in the document
(define (xlink:uri doc)
(let((nodeset ((sxpath '(@@ uri)) doc)))
(if(null? nodeset) ; there is no "@@/uri" subtree
#f
(cadar nodeset))))
This function inserts a uri auxiliary subtree with a 'uri-string' If the 'doc' already contains such a subtree, an old uri-string will be replaced be the new one. Other subtrees in an auxiliary list are not modified The new 'doc' is returned
(define (xlink:add-uri uri-string doc)
(let((aux-subtrees
((select-kids
(lambda (node)
(not (and (pair? node) (equal? (car node) 'uri)))))
((select-kids (ntype?? '@@))
doc)))
(kids
((select-kids
(lambda (node)
(not (and (pair? node) (equal? (car node) '@@)))))
doc)))
(cons* '*TOP*
(cons* '@@
(list 'uri uri-string)
aux-subtrees)
kids)))
This function returns a document's 'id-index' #f is returned is there is no "@@/id-index" subtree in the document
(define (xlink:id-index doc)
(let((nodeset ((sxpath '(@@ id-index)) doc)))
(if(null? nodeset) ; there is no "@@/id-index" subtree
#f
(cdar nodeset))))
This function returns document's 'traversal-info' #f is returned is there is no "@@/sxlink/traversal-info" subtree
(define (xlink:traversal-info doc)
(let((nodeset ((sxpath '(@@ sxlink traversal-info)) doc)))
(if(null? nodeset) ; there is no "@@/sxlink/traversal-info" subtree
#f
(cdar nodeset))))
This function returns document's 'roles' #f is returned is there is no "@@/sxlink/roles" subtree in the document
(define (xlink:roles doc)
(let((nodeset ((sxpath '(@@ sxlink roles)) doc)))
(if(null? nodeset) ; there is no "@@/sxlink/roles" subtree
#f
(cdar nodeset))))
This function returns document's 'roles' #f is returned is there is no "@@/sxlink/arcroles" subtree in the document
(define (xlink:arcroles doc)
(let((nodeset ((sxpath '(@@ sxlink arcroles)) doc)))
(if(null? nodeset) ; there is no "@@/sxlink/arcroles" subtree
#f
(cdar nodeset))))
This function returns both document's 'roles' and 'arcroles' #f is returned is there is no "@@/sxlink/(roles | arcroles)" subtree in the document.
(define (xlink:roles+arcroles doc)
(let((nodeset
((select-kids
(lambda(node)
(and (pair? node) (memq (car node) '(roles arcroles)))))
((select-kids (ntype?? 'sxlink))
((select-kids (ntype?? '@@)) doc)))))
(if(null? nodeset) ; there are no "@@/sxlink/(roles | arcroles)" subtrees
#f
(apply append (map cdr nodeset)))))
The function returns the list of loaded document's uris
(define (xlink:uris doc-set)
(filter
(lambda (x) x)
(map
xlink:uri
doc-set)))
The function returns a list of URIs which are refered by XLink markup Result: uri-list The list may contain duplicates.
(define (xlink:referenced-uris doc-set)
(filter
(lambda (x) x)
(map
xlink:one-to-many-uri
(apply
append
(filter
(lambda (x) x)
(map
xlink:traversal-info
doc-set))))))
The function returns a list of linkbases' uris which are refered by XLink markup Result: uri-list The list may contain duplicates.
(define (xlink:referenced-linkbase-uris doc-set)
(filter
(lambda (x) x)
(map
(lambda (one-to-many-traverse)
(if(xlink:one-to-many-linkbase one-to-many-traverse)
(xlink:one-to-many-uri one-to-many-traverse)
#f))
(apply
append
(filter
(lambda (x) x)
(map
xlink:traversal-info
doc-set))))))
Finding a document in 'doc-set' by its 'uri-string' If there is no such document, #f is returned
(define (xlink:find-doc uri-string doc-set)
(let loop ((doc-set doc-set))
(cond
((null? doc-set) #f)
((equal? (xlink:uri (car doc-set)) uri-string)
(car doc-set))
(else (loop (cdr doc-set))))))
The function loads one or more XML documents Arguments: one or more 'uri-string's. Each of them locates a resource Result: 'doc-set'
(define (xlink:load-docs uri-string . uri-strings)
(let((parser (SSAX:multi-parser 'id 'xlink)))
(let loop ((uri-list (cons uri-string uri-strings))
(doc-set '()))
(if
(null? uri-list)
doc-set
(let((uri (car uri-list)))
(let((port (open-input-resource uri)))
(if
(not port) ; resource not available, message already displayed
(loop (cdr uri-list) doc-set)
(with-exception-handler
(lambda (x)
(close-input-port port)
(loop (cdr uri-list) doc-set))
(lambda ()
(let((doc (parser port)))
(close-input-port port)
(loop
(cdr uri-list)
(cons (xlink:add-uri uri doc) doc-set))))))))))))
This function recursively loads all linkbases which are refered by XLink markup in 'doc-set' "Recursively" means that if a loaded linkbase refers to another linkbase, the latter one will be loaded either, and so on. 'max-steps' argument, if presented, limits the maximum number of steps in a "chain" of linkbases. If curcular references occur, this situation is discovered Result: a 'doc-set' which contains all documents from the source 'doc-set' plus all loaded linkbase documents
(define (xlink:load-linkbases-recursively doc-set . max-steps)
(let((parser (SSAX:multi-parser 'id 'xlink))
(max-steps (if(null? max-steps) -1 (car max-steps))))
(let loop ((doc-set doc-set)
(loaded-uris (xlink:uris doc-set))
(to-load (xlink:referenced-linkbase-uris doc-set))
(step 0))
(if
(or (null? to-load) (= step max-steps))
doc-set
(let rpt ((loaded-uris loaded-uris)
(to-load to-load)
(added-docs '()))
(cond
((null? to-load)
(loop (append added-docs doc-set)
loaded-uris
(xlink:referenced-linkbase-uris added-docs)
(+ step 1)))
((member (car to-load) loaded-uris)
(rpt loaded-uris
(cdr to-load)
added-docs))
(else ; we try to load the linkbase
(let((uri (car to-load)))
(let((port (open-input-resource uri)))
(if
(not port) ; resource not available
(rpt (cons uri loaded-uris)
(cdr to-load)
added-docs)
(with-exception-handler
(lambda (x)
(close-input-port port)
(rpt (cons uri loaded-uris)
(cdr to-load)
added-docs))
(lambda ()
(let((doc (parser port)))
(close-input-port port)
(rpt
(cons uri loaded-uris)
(cdr to-load)
(cons (xlink:add-uri uri doc)
added-docs)))))))))))))))
This function recursively loads all documents (resources) which are refered by XLink markup in 'doc-set' "Recursively" means that if a loaded document refers to another document, the latter one will be loaded either, and so on. 'max-steps' argument, if presented, limits the maximum number of steps in a "chain" of documents. If curcular references occur, this situation is discovered. Result: a 'doc-set' which contains documents from the source 'doc-set' plus all loaded documents
(define (xlink:load-docs-recursively doc-set . max-steps)
(let((parser (SSAX:multi-parser 'id 'xlink))
(max-steps (if(null? max-steps) -1 (car max-steps))))
(let loop ((doc-set doc-set)
(loaded-uris (xlink:uris doc-set))
(to-load (xlink:referenced-uris doc-set))
(step 0))
(if
(or (null? to-load) (= step max-steps))
doc-set
(let rpt ((loaded-uris loaded-uris)
(to-load to-load)
(added-docs '()))
(cond
((null? to-load)
(loop (append added-docs doc-set)
loaded-uris
(xlink:referenced-uris added-docs)
(+ step 1)))
((member (car to-load) loaded-uris)
(rpt loaded-uris
(cdr to-load)
added-docs))
(else ; we try to load the linkbase
(let((uri (car to-load)))
(let((port (open-input-resource uri)))
(if
(not port) ; resource not available
(rpt (cons uri loaded-uris)
(cdr to-load)
added-docs)
(with-exception-handler
(lambda (x)
(close-input-port port)
(rpt (cons uri loaded-uris)
(cdr to-load)
added-docs))
(lambda ()
(let((doc (parser port)))
(close-input-port port)
(rpt
(cons uri loaded-uris)
(cdr to-load)
(cons (xlink:add-uri uri doc)
added-docs)))))))))))))))
Accessors for 'uri-related-traverses'
(define xlink:uri-traverses-uri car)
(define xlink:uri-traverses-linkbase cadr)
(define xlink:uri-traverses-one-to-many cddr)
Mutator for 'uri-related-traverses' list-uri-related-one-to-many = (list uri-related-one-to-many uri-related-one-to-many ...)
(define (xlink:make-uri-traverses uri linkbase list-uri-related-one-to-many) (cons* uri linkbase list-uri-related-one-to-many))
Accessors for 'uri-related-one-to-many'
(define xlink:uri-one-to-many-fragment car)
(define xlink:uri-one-to-many-role cadr)
(define xlink:uri-one-to-many-uri caddr)
(define xlink:uri-one-to-many-position cadddr)
(define (xlink:uri-one-to-many-element uri-related-one-to-many) (list-ref uri-related-one-to-many 4))
(define (xlink:uri-one-to-many-single uri-related-one-to-many) (cdr (cddddr uri-related-one-to-many)))
Mutator for 'uri-related-one-to-many' single-traverses = (list single-traverse single-traverse ...)
(define (xlink:make-uri-one-to-many
fragment role uri-where-declared position element single-traverses)
(cons* fragment role uri-where-declared position element single-traverses))
Given 'doc-set' the function constructs 'sorted-traversal-info'
(define (xlink:doc-set->sorted-traversal doc-set)
(let loop ((pair-list
(map
(lambda (doc)
(cons (xlink:uri doc)
(xlink:traversal-info doc)))
doc-set))
(traversal-info '()))
(if
(not (null? pair-list))
(let((uri (caar pair-list))
(t-i (cdar pair-list)))
(if
(not (and uri t-i)) ; an incorrect doc - ignoring it
(loop (cdr pair-list) traversal-info)
(loop
(cdr pair-list)
(append
(map
(lambda (one-to-many-traverse)
(let((uri-string (xlink:one-to-many-uri one-to-many-traverse)))
(cons*
(if uri-string uri-string uri)
(xlink:one-to-many-linkbase one-to-many-traverse)
(xlink:one-to-many-fragment one-to-many-traverse)
(xlink:one-to-many-role one-to-many-traverse)
uri
(cddddr one-to-many-traverse))))
t-i)
traversal-info))))
; 'pair-list' is over
; all uris are strings in 'traversal-info'
(let rpt ((traversal-info traversal-info)
(sorted-t-i '()))
(if
(null? traversal-info)
sorted-t-i
(let((one-to-many (car traversal-info)))
(let back ((uri (xlink:one-to-many-uri one-to-many))
(linkbase (xlink:one-to-many-linkbase one-to-many))
(traverses (list (cddr one-to-many)))
(traversal-info '())
(more (cdr traversal-info)))
(if
(null? more)
(rpt
traversal-info
(cons
(xlink:make-uri-traverses uri linkbase traverses)
sorted-t-i))
(let((one-to-many (car more)))
(if
(string=? (xlink:one-to-many-uri one-to-many) uri)
(back
uri
(or linkbase (xlink:one-to-many-linkbase one-to-many))
(cons (cddr one-to-many) traverses)
traversal-info
(cdr more))
(back
uri
linkbase
traverses
(cons (car more) traversal-info)
(cdr more))))))))))))
Unite two or more 'sorted-traversal-info's
(define (xlink:unite-sorted-traversal-info sorted1 sorted2 . others)
(let loop ((res sorted1)
(src (apply
append
(cons sorted2 others))))
(if
(null? src)
res
(let((uri-traverses (car src)))
(let((uri (xlink:uri-traverses-uri uri-traverses))
(linkbase (xlink:uri-traverses-linkbase uri-traverses)))
(let rpt ((before '())
(after res))
(if
(null? after)
(loop
(cons uri-traverses res)
(cdr src))
(let((first (car after)))
(if
(string=? (xlink:uri-traverses-uri first) uri)
(loop
(append
(reverse before)
(list
(xlink:make-uri-traverses
uri
(or linkbase (xlink:uri-traverses-linkbase first))
(append
(xlink:uri-traverses-one-to-many uri-traverses)
(xlink:uri-traverses-one-to-many first))))
(cdr after))
(cdr src))
(rpt
(cons (car after) before)
(cdr after)))))))))))
This function checks the validity of all resource references contained in 'sorted-traversal-info' If everything is ok, #t is returned. Otherwise, function returns #f and error messages are displayed as a side effect.
(define (xlink:validate-resources sorted-traversal-info doc-set)
(let((parser (SSAX:multi-parser))
(id-parser (SSAX:multi-parser 'id)))
(let loop ((sorted-traversal-info sorted-traversal-info)
(ok #t))
(if
(null? sorted-traversal-info)
ok
(let*((uri-traverses (car sorted-traversal-info))
(uri (xlink:uri-traverses-uri uri-traverses)))
(let rpt ((xml (xlink:uri-traverses-linkbase uri-traverses))
(pos-pairs '())
(func-triples '())
(index-required #f)
(ok ok)
(list-one-to-many (xlink:uri-traverses-one-to-many
uri-traverses)))
(if
(not (null? list-one-to-many))
(let((one-to-many (car list-one-to-many)))
(let((fragment
(xlink:uri-one-to-many-fragment one-to-many))
(uri-where-declared
(xlink:uri-one-to-many-uri one-to-many))
(position
(xlink:uri-one-to-many-position one-to-many)))
(cond
((pair? fragment) ; a local resource
(rpt
#t
(cons (cons uri-where-declared position) pos-pairs)
func-triples
index-required
ok
(cdr list-one-to-many)))
((not fragment) ; the whole resource
(rpt
xml
(cons (cons uri-where-declared position) pos-pairs)
func-triples
index-required
ok
(cdr list-one-to-many)))
(else ; an XPointer part
(let((res (sxp:xpointer+index fragment)))
(cond
((not res) ; incorrect path
(cerr
uri-where-declared ", position " position
": incorrect XPointer identifier - " fragment nl)
(rpt
#t
(cons (cons uri-where-declared position) pos-pairs)
func-triples
index-required
#f
(cdr list-one-to-many)))
(else
(rpt
#t
(cons (cons uri-where-declared position) pos-pairs)
(cons (cons* (car res) uri-where-declared
position fragment)
func-triples)
(or index-required (cdr res))
ok
(cdr list-one-to-many)))))))))
; 'list-one-to-many' is null, information was formed at last
(if
(not xml) ; the resource may not be an XML document
(cond
((or (member uri (xlink:uris doc-set))
(resource-exists? uri))
(loop (cdr sorted-traversal-info) ok))
(else ; resource doesn't exist
(cerr nl)
(map
(lambda (pos-pair)
(cerr (car pos-pair) ", position " (cdr pos-pair)
" - resource " uri " doesn't exist" nl))
pos-pairs)
(loop (cdr sorted-traversal-info) #f)))
; the resource is an XML document
(let((doc
(cond
((xlink:find-doc uri doc-set)
=> (lambda (x) x))
(index-required
(let((port (open-input-resource uri)))
(cond
((not port)
(map
(lambda (pos-pair)
(cerr (car pos-pair) ", position " (cdr pos-pair)
" - resource " uri " doesn't exist" nl))
pos-pairs)
#f)
(else
(with-exception-handler
(lambda (x)
(close-input-port port)
(map
(lambda (pos-pair)
(cerr (car pos-pair) ", position "
(cdr pos-pair) " - resource " uri
" is not an well-formed"
" XML document" nl))
pos-pairs)
#f)
(lambda ()
(let((doc (id-parser port)))
(close-input-port port)
doc)))))))
(else
(let((port (open-input-resource uri)))
(cond
((not port)
(map
(lambda (pos-pair)
(cerr (car pos-pair) ", position " (cdr pos-pair)
" - resource " uri " doesn't exist" nl))
pos-pairs)
#f)
(else
(with-exception-handler
(lambda (x)
(close-input-port port)
(map
(lambda (pos-pair)
(cerr (car pos-pair) ", position "
(cdr pos-pair) " - resource " uri
" is not an well-formed"
" XML document" nl))
pos-pairs)
#f)
(lambda ()
(let((doc (parser port)))
(close-input-port port)
doc))))))))))
(if
(not doc) ; failure, message already displayed
(loop (cdr sorted-traversal-info) #f)
(let((id-index
(cond
((xlink:id-index doc)
=> (lambda (x) x))
(else '()))))
(let back ((func-triples func-triples)
(ok ok))
(if
(null? func-triples)
(loop (cdr sorted-traversal-info) ok)
(let((triple (car func-triples)))
(let((nset ((car triple) doc id-index)))
(cond
((or (null? nset) (not (nodeset? nset)))
(cerr
nl (cadr triple) ", position " (caddr triple)
": an XPointer identifier doesn't point"
" to any location - " (cdddr triple) nl)
(back (cdr func-triples) #f))
(else
(back (cdr func-triples) ok))))))))))))))))))
Mutator for a 'role-related-info'
(define (xlink:make-role-related-info role list-single-declaration) (cons role list-single-declaration))
Accessors for 'single-declaration'
(define xlink:single-declaration-uri car)
(define xlink:single-declaration-position cadr)
(define xlink:single-declaration-element caddr)
Mutator for 'role-info'
(define (xlink:make-single-declaration uri-where-declared position element) (list uri-where-declared position element))
Given 'doc-set' the function constructs 'sorted-roles' accessor = xlink:roles | xlink:arcroles | xlink:roles+arcroles accessor returns document's 'roles' and/or 'arcroles'
(define (xlink:doc-set->sorted-roles doc-set accessor)
(let loop ((ext-roles
(apply
append
(map
(lambda (doc)
(let((uri-string (xlink:uri doc))
(roles (accessor doc)))
(if
(not (and uri-string roles))
'()
(map
(lambda (role-info)
(cons* (car role-info) uri-string (cdr role-info)))
roles))))
doc-set)))
(sorted '()))
(if
(null? ext-roles)
sorted
(let((role-info (car ext-roles)))
(let rpt ((role (car role-info))
(list-single (list (cdr role-info)))
(ext-roles '())
(more (cdr ext-roles)))
(if
(null? more)
(loop
ext-roles
(cons (xlink:make-role-related-info role list-single) sorted))
(let((role-info (car more)))
(if
(string=? (car role-info) role)
(rpt
role
(cons (cdr role-info) list-single)
ext-roles
(cdr more))
(rpt
role
list-single
(cons role-info ext-roles)
(cdr more))))))))))
Unite two or more 'sorted-roles'
(define (xlink:unite-sorted-roles sorted1 sorted2 . others)
(let loop ((res sorted1)
(src (apply
append
(cons sorted2 others))))
(if
(null? src)
res
(let((role-related (car src)))
(let((role (car role-related)))
(let rpt ((before '())
(after res))
(if
(null? after)
(loop
(cons role-related res)
(cdr src))
(let((first (car after)))
(if
(string=? (car first) role)
(loop
(append
(reverse before)
(list
(cons role (append (cdr role-related) (cdr first))))
(cdr after))
(cdr src))
(rpt
(cons (car after) before)
(cdr after)))))))))))
This function checks the validity of all role references contained in 'sorted-roles' If everything is ok, #t is returned. Otherwise, function returns #f and error messages are displayed as a side effect.
(define (xlink:validate-roles sorted-roles)
(let loop ((sorted-roles sorted-roles)
(ok #t))
(if
(null? sorted-roles)
ok
(let*((role-related (car sorted-roles))
(role (car role-related)))
(cond
((resource-exists? (car role-related))
(loop (cdr sorted-roles) ok))
(else
(cerr nl)
(for-each
(lambda (single-declaration)
(cerr
(xlink:single-declaration-uri single-declaration) ", position "
(xlink:single-declaration-position single-declaration)
": resource doesn't exist - " role nl))
(cdr role-related))
(loop (cdr sorted-roles) #f)))))))
Accessors for a 'possible-traverse'
(define xlink:possible-traverse-uri car)
(define xlink:possible-traverse-fragment cadr)
(define xlink:possible-traverse-arcrole caddr)
(define xlink:possible-traverse-show cadddr)
(define (xlink:possible-traverse-actuate possible-traverse) (list-ref possible-traverse 4))
A mutator for a 'possible-traverse'
(define (xlink:make-possible-traverse uri fragment arcrole show actuate) (list uri fragment arcrole show actuate))
This handler returns an ending resorce. If more than one traversals are possible, one of them is chosen. No order is specified for 'possible-traverses', so it is not advised to use this handler if multiple traverses are defined for some starting resource. (nih is short for "Node Inclusion Handler")
(define (xlink:nih-ending-resource start-node possible-traverses)
(let((possible-traverse (car possible-traverses)))
(xlink:possible-traverse-fragment possible-traverse)))
Given a 'filter-pred?' this function returns an inclusion handler filter-pred? = (lambda (possible-traverse) ...) 'possible-traverses' are filtered with a 'filter-pred'. Three situations: 1. If a filtered list is empty, the 'start-node' remains unchanged; 2. If a filtered list contains exactly one traverse, its ending resource is returned; 3. Otherwise, one traverse is chosen. Its ending resource is returned. If given a filter-pred? = (lambda (possible-traverse) #t) this function becomes an 'xlink:nih-ending-resource' handler.
(define (xlink:nih-filtered-ending-resource filter-pred?)
(lambda (start-node possible-traverses)
(let((possible-traverses (filter filter-pred? possible-traverses)))
(if(null? possible-traverses)
start-node
(let((possible-traverse (car possible-traverses)))
(xlink:possible-traverse-fragment possible-traverse))))))
This handler simply removes a 'start-node' without inserting anything instead.
(define (xlink:nih-remove start-node possible-traverses) '())
This handler keeps an 'extended-element' unchanged
(define (xlink:elh-preserve extended-element) extended-element)
This handler completely removes an 'extended-element' from a resulting document (together with all its descendants)
(define (xlink:elh-remove extended-element) '())
The handler removes only those elements which have an XLink-related meaning (i.e. an extended link element; its locator-, resource-, are- and title- children; locator's and arc's title- children). Their child elements are combined into a nodeset, which is returned as a result ATTENTION: It is theoretically possible that some non-XLink descendant elements become XLink elements after such a transformation (for example, a nested element with an xlink:type="simple" or "extended"). That's why this handler should be used carefully
(define (xlink:elh-remove-related extended-element)
(let loop ((nset ((select-kids
(lambda (node)
(not (and (pair? node) (equal? (car node) '@)))))
extended-element))
(res '()))
(if
(null? nset)
(reverse res)
(let((node (car nset)))
(cond
((or (xlink:title? node) (xlink:resource? node))
(loop (cdr nset) res))
((or (xlink:locator? node) (xlink:arc? node))
(loop
(cdr nset)
(append
(reverse
((select-kids
(lambda (node)
(and (sxp:node? node) (not (xlink:title? node)))))
node))
res)))
(else
(loop (cdr nset) (cons node res))))))))
This handler removes an xlink:type attribute from an 'extended-element'. An 'extended-element' in not an XLink element after such a transformation; all its locator-, resource-, arc- and title- child elements are not XLink elements too then. ATTENTION: It is theoretically possible that some non-XLink descendant elements become XLink elements after such a transformation (for example, a nested element with an xlink:type="simple" or "extended"). That's why this handler should be used carefully.
(define (xlink:elh-remove-type-attribute extended-element)
(let((name (car extended-element))
(attrs
((select-kids
(lambda (node)
(not (equal? (car node) 'http://www.w3.org/1999/xlink:type))))
((select-kids (ntype?? '@))
extended-element)))
(kids
((select-kids
(lambda (node)
(not (and (pair? node) (equal? (car node) '@)))))
extended-element)))
(if(null? attrs)
(cons name kids)
(cons* name
(cons '@ attrs)
kids))))
This handler keeps an 'auxiliary-list' unchanged
(define (xlink:alh-preserve auxiliary-list) auxiliary-list)
This handler completely removes an 'auxiliary-list' from a resulting document (together with all its descendants)
(define (xlink:alh-remove auxiliary-list) '())
This function implement a node inclusion operation (see a comment at the beginning of this chapter) dereferenced-doc - a document to which an 'xlink:xpointer-dereference' operation has been applied (i.e. it contains an "@@/sxlink/resolved" subtree ni-handler - a node inclusion handler (see "Inclusion handlers" section) el-handler - an extended-link handler (see "Transforming extended link elements" section) al-handler - an auxiliary list handler (see "Transforming an auxiliary list" section) A document with replaced nodes is returned.
(define (xlink:include-nodes dereferenced-doc doc-set
ni-handler el-handler al-handler)
(define (ni-helper node alist e-e)
(if
(not (pair? node)) ; a text node
(cond
((assoc node alist)
=> (lambda (el)
(ni-handler node (cdr el))))
(else
node))
(let((new-e-e (and e-e (not (xlink:extended? node)))))
(let((new-node
(cons
(car node)
(apply
append
(map
(lambda (n)
(if((ntype?? '@@) n) ; an aux list node
(let((new-n (al-handler n)))
(if(nodeset? new-n)
new-n
(list new-n)))
(let((new-n (ni-helper n alist new-e-e)))
(if(nodeset? new-n)
new-n
(list new-n)))))
((select-kids (lambda (x) #t)) node))))))
(cond
((assoc node alist)
=> (lambda (el)
(ni-handler new-node (cdr el))))
((and e-e (xlink:extended? new-node))
(el-handler new-node))
(else
new-node))))))
(let((id-parser (SSAX:multi-parser 'id))
(resolved-traverses (xlink:resolved dereferenced-doc)))
(if
(not resolved-traverses) ; XPointer hasn't been dereferenced
dereferenced-doc
(let loop ((resolved-traverses resolved-traverses)
(alist '())
(doc-set doc-set)
(resource-pairs '()))
(if
(null? resolved-traverses)
(ni-helper dereferenced-doc alist #t)
(let*((r-t (car resolved-traverses))
(fragment (xlink:uri-one-to-many-fragment r-t))
(uri-where-declared (xlink:uri-one-to-many-uri r-t)))
(let rpt ((single-traverses
(apply
append
(map
xlink:uri-one-to-many-single
(filter
(lambda (one-to-many)
(eq? (xlink:uri-one-to-many-fragment one-to-many)
fragment))
resolved-traverses))))
(possible-traverses '())
(doc-set doc-set)
(resource-pairs resource-pairs))
(if
(null? single-traverses)
(if
(null? possible-traverses)
(loop
(filter
(lambda (one-to-many)
(not (eq? (xlink:uri-one-to-many-fragment one-to-many)
fragment)))
resolved-traverses)
alist
doc-set
resource-pairs)
(loop
(filter
(lambda (one-to-many)
(not (eq? (xlink:uri-one-to-many-fragment one-to-many)
fragment)))
resolved-traverses)
(cons (cons fragment possible-traverses) alist)
doc-set
resource-pairs))
(let*((s-t (car single-traverses))
(uri (xlink:single-traverse-uri s-t))
(fr (xlink:single-traverse-fragment s-t))
(position (xlink:single-traverse-position s-t))
(arcrole (xlink:single-traverse-arcrole s-t))
(show (xlink:single-traverse-show s-t))
(actuate (xlink:single-traverse-actuate s-t)))
(cond
((equal? arcrole xlink:linkbase-uri) ; a linkbase - skip it
(rpt
(cdr single-traverses)
possible-traverses
doc-set
resource-pairs))
((pair? fr) ; a local resource
(rpt
(cdr single-traverses)
(cons
(xlink:make-possible-traverse uri fr arcrole show actuate)
possible-traverses)
doc-set
resource-pairs))
((string? fr) ; an XPointer identifier
(let-values*
(((document doc-set)
(cond
((not uri) ; the same document
(values dereferenced-doc
doc-set))
((xlink:find-doc uri doc-set)
=> (lambda (document)
(values document doc-set)))
(else
(let((port (open-input-resource uri)))
(if
(not port)
(values #f doc-set)
(with-exception-handler
(lambda (x)
(close-input-port port)
(cerr
uri-where-declared ", position "
position " - resource " uri
" is not an well-formed"
" XML document" nl)
(values #f doc-set))
(lambda ()
(let((document (xlink:add-uri
uri (id-parser port))))
(close-input-port port)
(values document
(cons document doc-set)))))))))))
(if
(not document) ; error loading it
(rpt
(cdr single-traverses)
possible-traverses
doc-set
resource-pairs)
(let((id-index
(cond
((xlink:id-index document)
=> (lambda (x) x))
(else '())))
(func (sxp:xpointer fr)))
(cond
((not func) ; parser error
(cerr
nl uri-where-declared ", position " position
": incorrect XPointer identifier - " fr nl)
(rpt
(cdr single-traverses)
possible-traverses
doc-set
resource-pairs))
(else
(let((nset (func document id-index)))
(cond
((or (null? nset) (not (nodeset? nset)))
(cerr
nl uri-where-declared ", position " position
": an XPointer identifier doesn't point"
" to any location - " fr nl)
(rpt
(cdr single-traverses)
possible-traverses
doc-set
resource-pairs))
(else
(rpt
(cdr single-traverses)
(cons
(xlink:make-possible-traverse
uri nset arcrole show actuate)
possible-traverses)
doc-set
resource-pairs))))))))))
(else ; the whole resource
(let-values*
(((document doc-set resource-pairs)
(cond
((not uri) ; the same document
(values dereferenced-doc
doc-set resource-pairs))
((xlink:find-doc uri doc-set)
=> (lambda (document)
(values document doc-set resource-pairs)))
((assoc uri resource-pairs)
=> (lambda (pair)
(values (cdr pair)
doc-set resource-pairs)))
(else
(let((port (open-input-resource uri)))
(if
(not port)
(values #f doc-set resource-pairs)
(with-exception-handler
(lambda (x)
(close-input-port port)
(let((port (open-input-resource uri)))
(if
(not port)
(values
#f doc-set resource-pairs)
(let back ((symb (peek-char port))
(res '()))
(cond
((eof-object? symb)
(close-input-port port)
(let((str (list->string
(reverse res))))
(values
str
doc-set
(cons
(cons uri str)
resource-pairs))))
(else
(let((symb (read-char port)))
(back
(peek-char port)
(cons symb res)))))))))
(lambda ()
(let((document (xlink:add-uri
uri (id-parser port))))
(close-input-port port)
(values document
(cons document doc-set)
resource-pairs))))))))))
(cond
((not document) ; error loading it
(rpt
(cdr single-traverses)
possible-traverses
doc-set
resource-pairs))
((pair? document) ; an SXML document
(let((root-node (car
((select-kids (ntype?? '*))
document))))
(rpt
(cdr single-traverses)
(cons
(xlink:make-possible-traverse
uri root-node arcrole show actuate)
possible-traverses)
doc-set
resource-pairs)))
(else ; a document is a text string
(rpt
(cdr single-traverses)
(cons
(xlink:make-possible-traverse
uri document arcrole show actuate)
possible-traverses)
doc-set
resource-pairs)))))))))))))))
This handler constructs a simple-link element If a 'start-node' is already a simple link element, it is not modified. If more than one traversals are possible, one of them is chosen. No order is specified for 'possible-traverses', so it is not advised to use this handler if multiple traverses are defined for some starting resource. (lrh is short for Link Resolution Handler)
(define (xlink:lrh-simple start-node possible-traverses)
(if
(xlink:simple? start-node)
start-node
(let((possible-traverse (car possible-traverses))
(start-nodeset (if(xlink:resource? start-node)
((select-kids sxp:node?) start-node)
(list start-node))))
(let((uri (xlink:possible-traverse-uri possible-traverse))
(fragment (xlink:possible-traverse-fragment possible-traverse))
(arcrole (xlink:possible-traverse-arcrole possible-traverse))
(show (xlink:possible-traverse-show possible-traverse))
(actuate (xlink:possible-traverse-actuate possible-traverse)))
(let((href
(if uri
(if fragment (string-append uri "#" fragment) uri)
(if fragment (string-append "#" fragment) "#"))))
(let((attlist
(filter
(lambda (x) x)
(list
(list 'http://www.w3.org/1999/xlink:type "simple")
(list 'http://www.w3.org/1999/xlink:href href)
(if arcrole
(list 'http://www.w3.org/1999/xlink:arcrole arcrole)
#f)
(if show
(list 'http://www.w3.org/1999/xlink:show show)
#f)
(if actuate
(list 'http://www.w3.org/1999/xlink:actuate actuate)
#f)))))
(cons* 'simple
(cons '@ attlist)
start-nodeset)))))))
This handler constructs an extended-link element with a 'start-node' as a resource-element, and 'possible traverses' as several locator- and outbound arc- elements.
(define (xlink:lrh-extended start-node possible-traverses)
(let((resource
(let((start-nodeset
(if
(or (xlink:resource? start-node) (xlink:simple? start-node))
((select-kids sxp:node?) start-node)
(list start-node))))
(cons* 'resource
'(@
(http://www.w3.org/1999/xlink:type "resource")
(http://www.w3.org/1999/xlink:label "local"))
start-nodeset))))
(let loop ((possible-traverses possible-traverses)
(locators '())
(arcs '())
(count 1))
(if
(null? possible-traverses)
(cons* 'extended
'(@ (http://www.w3.org/1999/xlink:type "extended"))
resource
(append locators arcs))
(let((possible-traverse (car possible-traverses)))
(let((uri (xlink:possible-traverse-uri possible-traverse))
(fragment (xlink:possible-traverse-fragment possible-traverse))
(arcrole (xlink:possible-traverse-arcrole possible-traverse))
(show (xlink:possible-traverse-show possible-traverse))
(actuate (xlink:possible-traverse-actuate possible-traverse)))
(let((href
(if uri
(if fragment (string-append uri "#" fragment) uri)
(if fragment (string-append "#" fragment) "#"))))
(let((locator
`(locator
(@
(http://www.w3.org/1999/xlink:type "locator")
(http://www.w3.org/1999/xlink:href ,href)
(http://www.w3.org/1999/xlink:label
,(string-append "remote" (number->string count))))))
(arc
(list
'arc
(filter
(lambda (x) x)
(list
'@
'(http://www.w3.org/1999/xlink:type "arc")
(if arcrole
(list 'http://www.w3.org/1999/xlink:arcrole arcrole)
#f)
(if show
(list 'http://www.w3.org/1999/xlink:show show)
#f)
(if actuate
(list 'http://www.w3.org/1999/xlink:actuate actuate)
#f)
'(http://www.w3.org/1999/xlink:from "local")
`(http://www.w3.org/1999/xlink:to
,(string-append "remote" (number->string count))))))))
(loop
(cdr possible-traverses)
(cons locator locators)
(cons arc arcs)
(+ count 1))))))))))
This is a combination of two previous handlers. If 'possible-traverses' consists of exactly one element, a simple-link element is constructed. Otherwise an extended-link element is constructed.
(define (xlink:lrh-any start-node possible-traverses)
(if(= (length possible-traverses) 1)
(xlink:lrh-simple start-node possible-traverses)
(xlink:lrh-extended start-node possible-traverses)))
This function returns an XPointer analog for an XLink local resource. Thus a local resource is always an element, an XPointer identifier can be constructed as a ChildSequence, i.e. "/m/n/k" node - a local resource's node doc - an SXML document A string representing an XPointer identifier is returned on success. In case of an error (a 'node' cannot be found within a 'doc') #f is returned.
(define (xlink:local->xpointer node doc)
(letrec
((helper
(lambda (path sub-doc)
(if
(eq? sub-doc node)
(apply
string-append
(apply
append
(map
(lambda (num)
(list "/" (number->string num)))
(reverse path))))
(let loop ((kids ((select-kids (ntype?? '*)) sub-doc))
(count 1))
(cond
((null? kids) #f)
((helper (cons count path) (car kids))
=> (lambda (x) x))
(else
(loop (cdr kids) (+ count 1)))))))))
(helper '() doc)))
This function implement a link resolution operation (see a comment at the beginning of this chapter) dereferenced-doc - a document to which an 'xlink:xpointer-dereference' operation has been applied (i.e. it contains an "@@/sxlink/resolved" subtree lr-handler - a link resolution handler (see "Link resolution handlers" section) el-handler - an extended-link handler (see "Transforming extended link elements" section) al-handler - an auxiliary list handler (see "Transforming an auxiliary list" section) A new document is returned
(define (xlink:resolve-links dereferenced-doc doc-set
lr-handler el-handler al-handler)
(define (lr-helper node alist e-e)
(if
(not (pair? node)) ; a text node
(cond
((assoc node alist)
=> (lambda (el)
(lr-handler node (cdr el))))
(else
node))
(let((new-e-e (and e-e (not (xlink:extended? node)))))
(let((new-node
(cons
(car node)
(apply
append
(map
(lambda (n)
(if((ntype?? '@@) n) ; an aux list node
(let((new-n (al-handler n)))
(if(nodeset? new-n)
new-n
(list new-n)))
(let((new-n (lr-helper n alist new-e-e)))
(if(nodeset? new-n)
new-n
(list new-n)))))
((select-kids (lambda (x) #t)) node))))))
(cond
((assoc node alist)
=> (lambda (el)
(lr-handler new-node (cdr el))))
((and e-e (xlink:extended? new-node))
(el-handler new-node))
(else
new-node))))))
(let((resolved-traverses (xlink:resolved dereferenced-doc)))
(if
(not resolved-traverses) ; XPointer hasn't been dereferenced
dereferenced-doc
(let loop ((resolved-traverses resolved-traverses)
(alist '()))
(if
(null? resolved-traverses)
(lr-helper dereferenced-doc alist #t)
(let*((r-t (car resolved-traverses))
(fragment (xlink:uri-one-to-many-fragment r-t)))
(let rpt ((single-traverses
(apply
append
(map
xlink:uri-one-to-many-single
(filter
(lambda (one-to-many)
(eq? (xlink:uri-one-to-many-fragment one-to-many)
fragment))
resolved-traverses))))
(possible-traverses '()))
(if
(null? single-traverses)
(if
(null? possible-traverses)
(loop
(filter
(lambda (one-to-many)
(not (eq? (xlink:uri-one-to-many-fragment one-to-many)
fragment)))
resolved-traverses)
alist)
(loop
(filter
(lambda (one-to-many)
(not (eq? (xlink:uri-one-to-many-fragment one-to-many)
fragment)))
resolved-traverses)
(cons (cons fragment possible-traverses) alist)))
(let*((s-t (car single-traverses))
(uri (xlink:single-traverse-uri s-t))
(fr (xlink:single-traverse-fragment s-t))
(position (xlink:single-traverse-position s-t))
(arcrole (xlink:single-traverse-arcrole s-t))
(show (xlink:single-traverse-show s-t))
(actuate (xlink:single-traverse-actuate s-t)))
(if
(pair? fr) ; a local resource
(let((document
(cond
((not uri) ; the same document
dereferenced-doc)
(else
(xlink:find-doc uri doc-set)))))
(if
(not document) ; no such document - strange...
(rpt
(cdr single-traverses)
possible-traverses)
(let((fr (xlink:local->xpointer fr document)))
(if
(not fr) ; an error - strange...
(rpt
(cdr single-traverses)
possible-traverses)
(rpt
(cdr single-traverses)
(cons
(xlink:make-possible-traverse
uri fr arcrole show actuate)
possible-traverses))))))
(rpt
(cdr single-traverses)
(cons
(xlink:make-possible-traverse
uri fr arcrole show actuate)
possible-traverses))))))))))))