Module: xlink

 XLink implementation and the API for XLink processing in Scheme

 This software is in Public Domain.
 IT IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND.

 Please send bug reports and comments to:
   lisovsky@acm.org      Kirill Lisovsky
   lizorkin@hotbox.ru    Dmitry Lizorkin

 doc ::= '(*TOP*
           (@@
            (sxlink
             (declared-here  <sxlink-arc>* )
             (embedded)?
             (outgoing
              (node  <sxlink-arc>+ )*
             )
            )
            ...   ; more aux list members
           )
          ...)


XLink-related node tests
f: xlink:ntype??
f: xlink:elem-extended?
f: xlink:elem-simple?
f: xlink:elem-locator?
f: xlink:elem-resource?
f: xlink:elem-arc?
f: xlink:elem-title?

Utility functions over document auxiliary information
Document's URI
f: xlink:set-uri
Id-index of the document
f: xlink:id-index
SXLink members of the auxiliary list
f: xlink:arcs-declared-here
f: xlink:arcs-embedded?
f: xlink:arcs-outgoing

Get the document by its URI
f: xlink:api-error
f: xlink:parser
f: xlink:get-document-by-uri

Loading multiple documents by their URIs
Helper accessors to SXLink arcs
f: xlink:arcs-uris
f: xlink:arcs-linkbase-uris
Working on the set of SXML documents
f: xlink:uris
f: xlink:remove-equal-duplicates
f: xlink:find-doc
Extending the set of documents with additional documents being referred to
f: xlink:referenced-uris
f: xlink:referenced-linkbase-uris
f: xlink:add-documents-helper
f: xlink:add-linkbases-recursively
f: xlink:add-documents-recursively
Higher-level functions
f: xlink:get-documents-with-params
f: xlink:get-documents+linkbases

Working on the set of linked documents
f: xlink:unite-duplicate-keys-in-alist
f: xlink:docs-exchange-arcs
Embedding XLink arcs into the document
f: xlink:embed-arcs-into-document
f: xlink:arcs-embedded

Load documents with respect to the other documents
f: xlink:parameterized-load-with-respect-documents
f: xlink:get-docs-with-respect-to-loaded

Excluding documents from linked-docs

High-level API functions
f: xlink:load-linked-docs-with-params
f: xlink:documents
f: xlink:documents-embed
Convenient function for getting a document by its URI
f: sxml:document

SXPath-related stuff
f: xlink:arc?
Working with the administrative variable '*docs*
f: xlink:docs-variable
f: xlink:add-docs-to-vars
Accessors to SXLink arcs that start from the given SXML node
f: xlink:node-embedded-arcs
f: xlink:node-arcs-on-top
f: xlink:node-arcs
Traversing SXLink arcs
f: xlink:traverse-arcs
Additional XPath axes
f: xlink:axis-arc
f: xlink:axis-traverse
f: xlink:axis-traverse-arc

XLink-related node tests

 They test whether an SXML node has a definite XLink type
 ATTENTION:
  1. A non-prefixed XLink namespace uri is used for these node tests. If
 a prefix is used, these functions behave incorrectly.
  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

xlink:ntype??

(define (xlink:ntype?? type)
... Full Code ... )
 Helper for predicates
  type - a string, is supposed to have one of the following values:
 "extended", "simple", "locator", "resource", "arc", "title".
 A lambda is returned. When applied to an SXML node, it determines
 whether the node's xlink:type attribute has a 'type' value.


xlink:elem-extended?

(define xlink:elem-extended?
... Full Code ... )
 Node tests for different XLink elements


xlink:elem-simple?

(define xlink:elem-simple?
... Full Code ... )


xlink:elem-locator?

(define xlink:elem-locator?
... Full Code ... )


xlink:elem-resource?

(define xlink:elem-resource?
... Full Code ... )


xlink:elem-arc?

(define xlink:elem-arc?
... Full Code ... )


xlink:elem-title?

(define xlink:elem-title?
... Full Code ... )



Utility functions over document auxiliary information



Document's URI

 The following functions moved to "xlink-parser.scm"
  xlink:get-uri
  xlink:set-uri-for-sxlink-arcs

xlink:set-uri

(define (xlink:set-uri uri doc)
... Full Code ... )
 Sets the URI for the SXML document



Id-index of the document


xlink:id-index

(define (xlink:id-index doc)
... Full Code ... )
 Returns the id-index of the SXML document
 #f is returned is there is no "@@/id-index" subtree in the document



SXLink members of the auxiliary list


xlink:arcs-declared-here

(define (xlink:arcs-declared-here doc)
... Full Code ... )
 Returns (listof sxlink-arc) located in "@@/sxlink/declared-here"
 These are SXLink arcs that are declared in this document


xlink:arcs-embedded?

(define (xlink:arcs-embedded? doc)
... Full Code ... )
 Whether outgoing SXLink arcs are embedded into the document.
 This is denoted by the presense of "@@/sxlink/embedded" empty element.


xlink:arcs-outgoing

(define (xlink:arcs-outgoing doc)
... Full Code ... )
 Returns the content of "@@/sxlink/outgoing"
 The result is the associative list between nodes of the document and
 SXLink arcs that start from the corresponding node



Get the document by its URI


xlink:api-error

(define (xlink:api-error . text)
... Full Code ... )
 Handler for error messages


xlink:parser

(define xlink:parser
... Full Code ... )
 Id+XLink parser parameterized


xlink:get-document-by-uri

(define (xlink:get-document-by-uri req-uri)
... Full Code ... )
 Returns the SXML representation for the resource specified by REQ-URI.
 Resource types supported: XML and HTML. XML is parsed into SXML with SSAX,
 HTML is parsed with HTML Prag.
 Additionally, linking information is parsed. For XML, linking information is
 assumed to be specified with XLink. For HTML, <a> elements are treated as
 simple links.
 In case of an error (resource doesn't exist or its type is unsupported), an
 error is signalled with 'xlink:api-error' and #f is returned.



Loading multiple documents by their URIs



Helper accessors to SXLink arcs


xlink:arcs-uris

(define (xlink:arcs-uris sxlink-arcs)
... Full Code ... )
 Returns URIs of resources that participate in SXLink arcs
  sxlink-arcs ::= (listof sxlink-arc)
 Result: (listof string)
 The result may contain duplicates


xlink:arcs-linkbase-uris

(define (xlink:arcs-linkbase-uris sxlink-arcs)
... Full Code ... )
 Returns URIs of all linkbases encountered among SXLink arcs
 Result: (listof string)
 The result may contain duplicates



Working on the set of SXML documents

  doc-set ::= (listof document)

xlink:uris

(define (xlink:uris doc-set)
... Full Code ... )
 Returns the list of URIs of the documents in the doc-set


xlink:remove-equal-duplicates

(define (xlink:remove-equal-duplicates lst)
... Full Code ... )
 Removes equal duplicates from the list


xlink:find-doc

(define (xlink:find-doc uri-string doc-set)
... Full Code ... )
 procedure xlink:find-doc :: URI-STRING (listof SXML-TREE) -> SXML-TREE

 Finding a document in 'doc-set' by its 'uri-string'.
 If there is no such document, #f is returned.
  doc-set ::= (listof SXML-TREE)



Extending the set of documents with additional documents being referred to


xlink:referenced-uris

(define (xlink:referenced-uris doc-set)
... Full Code ... )
 Returns a list of URIs which are refered by XLink markup
 Result:  (listof string)
 The list may contain duplicates.


xlink:referenced-linkbase-uris

(define (xlink:referenced-linkbase-uris doc-set)
... Full Code ... )
 Returns a list of linkbase URIs which are refered by XLink markup
 Result:  (listof string)
 The list may contain duplicates.


xlink:add-documents-helper

(define (xlink:add-documents-helper referenced-uris)
... Full Code ... )
 A helped low-level function for extending the doc-set with more documents
 Is parameterized with
  referenced-uris ::= (lambda (doc-set) ...)
 that would return URIs refered by XLink markup in the doc-set
 When parameterized, returns
  (lambda (doc-set . max-steps) ...)
  max-steps - maximal number of recursive steps
  The lambda returns the expanded doc-set


xlink:add-linkbases-recursively

(define xlink:add-linkbases-recursively
... Full Code ... )
 Two most common parameterized functions. The first one recursively loads
 linkbases. The second one recursively loads all refered documents


xlink:add-documents-recursively

(define xlink:add-documents-recursively
... Full Code ... )



Higher-level functions


xlink:get-documents-with-params

(define (xlink:get-documents-with-params . options)
... Full Code ... )
 Parameterized with options, returns
  (lambda (uri . uris) ...)
 which is the lambda for getting documents by their URIs
 Options include the following:
  'linkbases - load linkbases recursively
  '(linkbases  <number> ) - load linkbases recursively, with the maximal
 number of recursive steps defined by the <number> supplied
  'docs - load documents recursively
  '(docs  <number> ) - load documents recursively, with the maximal number
 of recursive steps defined by the <number> supplied


xlink:get-documents+linkbases

(define xlink:get-documents+linkbases
... Full Code ... )
 The most common parameterized case.
 Loads documents and all linkbases



Working on the set of linked documents

  linked-docs ::= (listof document)

xlink:unite-duplicate-keys-in-alist

(define (xlink:unite-duplicate-keys-in-alist alist)
... Full Code ... )
  alist ::= (listof
             (cons key (listof item)))
 For equal keys in the alist, the function unites the corresponding key values
 Returns the new alist


xlink:docs-exchange-arcs

(define (xlink:docs-exchange-arcs doc-set . sxlink-arcs)
... Full Code ... )
 Documents exchange their SXLink arcs, such as each arc is moved to the
 "@@/sxlink/outgoing" branch of the document where the arc's starting
 resource is
 Additional SXLink arcs may be specified in the optional argument.



Embedding XLink arcs into the document

 The element node with embedded XLink arcs looks as follows
  element-node ::= (name
                    (@ ...)
                    (@@
                     (sxlink  <sxlink-arc>+ )
                     ...)  ; other members of the aux list
                    ...)
  attribute-node ::= (name "value"
                           (@@
                            (sxlink  <sxlink-arc>+ )
                            ...)  ; other members of the aux list
                          )

xlink:embed-arcs-into-document

(define (xlink:embed-arcs-into-document document)
... Full Code ... )
 Takes SXLink arcs outgoing from the document and embeds these arcs into
 element and attribute nodes of the document.
 The modified document is returned
 The function doesn't make a copy of nodes that remain unchanged


xlink:arcs-embedded

(define (xlink:arcs-embedded doc)
... Full Code ... )
 Returns all embedded SXLink arcs in the document
 Result: (listof sxlink-arc)



Load documents with respect to the other documents


xlink:parameterized-load-with-respect-documents

(define (xlink:parameterized-load-with-respect-documents . options)
... Full Code ... )
 Parameterized with options, returns
  (lambda (linked-docs uri . uris) ...)
 which is the lambda for getting more documents by their URIs
 Options include the following:
  'linkbases - load linkbases recursively
  '(linkbases  <number> ) - load linkbases recursively, with the maximal
                            number of recursive steps defined by the <number>
                            supplied
  'docs - load documents recursively
  '(docs  <number> ) - load documents recursively, with the maximal number
                       of recursive steps defined by the <number> supplied
  'embed - embed SXLink arcs into nodes that are starting resources for that
           arcs
  'no-embed - don't embed SXLink arcs into documents loaded


xlink:get-docs-with-respect-to-loaded

(define xlink:get-docs-with-respect-to-loaded
... Full Code ... )
 The most common case of parametrization



Excluding documents from linked-docs

 TODO: to be implemented later

High-level API functions


xlink:load-linked-docs-with-params

(define (xlink:load-linked-docs-with-params . options)
... Full Code ... )
 Parameterized with options, returns
  (lambda (uri . uris) ...)
 which is the lambda for getting documents by their URIs
 Options include the following:
  'linkbases - load linkbases recursively
  '(linkbases  <number> ) - load linkbases recursively, with the maximal
                            number of recursive steps defined by the <number>
                            supplied
  'docs - load documents recursively
  '(docs  <number> ) - load documents recursively, with the maximal number
                       of recursive steps defined by the <number> supplied
  'embed - embed SXLink arcs into nodes that are starting resources for that
           arcs


xlink:documents

(define xlink:documents
... Full Code ... )
 procedure xlink:documents :: {REQ-URI}+  -> (listof SXML-TREE)
 procedure xlink:documents-embed :: {REQ-URI}+  -> (listof SXML-TREE)

 Both `xlink:documents' and `xlink:documents-embed' accept one or more
 strings as their arguments. Each string supplied denotes the URI of the
 requested document to be loaded. The requested document(s) are loaded
 and are represented in SXML. All XLink links declared in these document(s)
 are represented as a set of SXLink arcs. If any XLink links refer to XLink
 linkbases [<a href="http://www.w3.org/TR/xlink/#xlg">XLink</a>],
 these linkbases are additionally loaded, for additional SXLink arcs
 declared there.

 The starting resource for each SXLink arc is determined:
 1. For each SXML document loaded, the function `xlink:document' adds all
    SXLink arcs whose starting resource is located within this document, to
    the auxiliary list of its document node (*TOP*).
 2. The function 'xlink:documents-embed' embeds each SXLink arc into its
    starting resource-node, via auxiliary list of that node. For text nodes
    serving for starting resources, their SXLink arcs are stored in the
    auxiliary list of the document node (*TOP*), since SXML text nodes do
    not support their own auxiliary lists.

 Supported URI formats:
  + local file
  + http:// schema

 Supported document formats: XML and HTML. In the case of HTML,
 <A> hyperlinks are considered as XLink simple links.

 Result: (listof SXML-TREE)
 A particular SXML document can be located in this list using the
 function `xlink:find-doc'.


xlink:documents-embed

(define xlink:documents-embed
... Full Code ... )



Convenient function for getting a document by its URI


sxml:document

(define (sxml:document req-uri . namespace-prefix-assig)
... Full Code ... )
 procedure sxml:document :: REQ-URI [NAMESPACE-PREFIX-ASSIG] ->
                             -> SXML-TREE

 Obtain a [possibly, remote] document by its URI
 Supported URI formats:  local file and HTTP schema
 Supported document formats:  XML and HTML

 REQ-URI - a string that contains the URI of the requested document
 NAMESPACE-PREFIX-ASSIG - is passed as-is to the SSAX parser: there it is
  used for assigning certain user prefixes to certain namespaces.
  NAMESPACE-PREFIX-ASSIG is an optional argument and has an effect for an
  XML resource only. For an HTML resource requested, NAMESPACE-PREFIX-ASSIG
  is silently ignored.

 Result: the SXML representation for the requested document



SXPath-related stuff


xlink:arc?

(define xlink:arc?
... Full Code ... )
 Whether an SXLink arc



Working with the administrative variable '*docs*


xlink:docs-variable

(define (xlink:docs-variable var-binding)
... Full Code ... )
 Returns the value of the administrative SXPath variable '*docs*
 This variable stores linked-docs


xlink:add-docs-to-vars

(define (xlink:add-docs-to-vars node var-binding)
... Full Code ... )
 Extends var-bindings with administative information about linked-docs
  node - a single node or a nodeset



Accessors to SXLink arcs that start from the given SXML node


xlink:node-embedded-arcs

(define (xlink:node-embedded-arcs node)
... Full Code ... )
 Returns SXLink arcs that are embedded into the node as aux list members
 Result: (listof sxlink-arc)


xlink:node-arcs-on-top

(define (xlink:node-arcs-on-top node document)
... Full Code ... )
 Returns SXLink arcs that are specified at the top-level of the document and
 start from node


xlink:node-arcs

(define (xlink:node-arcs node document)
... Full Code ... )
 Returns all SXLink arcs (both embedded and specified at the top-level) that
 start from ther node
 The union of the two previous functions



Traversing SXLink arcs


xlink:traverse-arcs

(define (xlink:traverse-arcs sxlink-arcs linked-docs num-ancestors)
... Full Code ... )
 Traverse all SXLink arcs to their ending resources
  sxlink-arcs ::= (listof sxlink-arc)
  linked-docs ::= (listof document)
  num-ancestors - number of ancestors required for ending resources



Additional XPath axes


xlink:axis-arc

(define (xlink:axis-arc test-pred? . num-ancestors)
... Full Code ... )
 XPath+XLink arc axis
 This axis returns all SXLink arcs that start from the context node
  num-ancestors is dummy here, since SXLink arcs don't have ancestors


xlink:axis-traverse

(define (xlink:axis-traverse test-pred? . num-ancestors)
... Full Code ... )
 XPath+XLink traverse axis
 This axis traverses from the context node
 The lambda produced additionally takes the var-binding. In var-binding, the
 linked-docs can be stored in the administrative variable '*docs*


xlink:axis-traverse-arc

(define (xlink:axis-traverse-arc test-pred? . num-ancestors)
... Full Code ... )
 XPath+XLink traverse-arc axis
 The axis traverses from the context node that is an SXLink arc
 The lambda produced additionally takes the var-binding. In var-binding, the
 linked-docs can be stored in the administrative variable '*docs*


Code

xlink:ntype??

Index
 Helper for predicates
  type - a string, is supposed to have one of the following values:
 "extended", "simple", "locator", "resource", "arc", "title".
 A lambda 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)))))

xlink:elem-extended?

Index
 Node tests for different XLink elements
(define xlink:elem-extended? (xlink:ntype?? "extended"))

xlink:elem-simple?

Index
(define xlink:elem-simple? (xlink:ntype?? "simple"))

xlink:elem-locator?

Index
(define xlink:elem-locator? (xlink:ntype?? "locator"))

xlink:elem-resource?

Index
(define xlink:elem-resource? (xlink:ntype?? "resource"))

xlink:elem-arc?

Index
(define xlink:elem-arc? (xlink:ntype?? "arc"))

xlink:elem-title?

Index
(define xlink:elem-title? (xlink:ntype?? "title"))

xlink:api-error

Index
 Handler for error messages
(define (xlink:api-error . text)
  (cerr "XLink API error: ")
  (apply cerr text)
  (cerr nl))

xlink:parser

Index
 Id+XLink parser parameterized
(define xlink:parser (ssax:multi-parser 'id 'xlink))

xlink:get-document-by-uri

Index
 Returns the SXML representation for the resource specified by REQ-URI.
 Resource types supported: XML and HTML. XML is parsed into SXML with SSAX,
 HTML is parsed with HTML Prag.
 Additionally, linking information is parsed. For XML, linking information is
 assumed to be specified with XLink. For HTML, <a> elements are treated as
 simple links.
 In case of an error (resource doesn't exist or its type is unsupported), an
 error is signalled with 'xlink:api-error' and #f is returned.
(define (xlink:get-document-by-uri req-uri)
  (case (ar:resource-type req-uri)
    ((#f)  ; resource doesn't exist
     (xlink:api-error "resource doesn't exist: " req-uri)
     #f)
    ((xml plain unknown)
     (let* ((port (open-input-resource req-uri))
            (doc (xlink:parser port)))
       (close-input-port port)
       (xlink:set-uri req-uri doc)))
    ((html)
     (let* ((port (open-input-resource req-uri))
            (doc (html->sxml port)))
       (close-input-port port)
       (SHTML->SHTML+xlink
        (xlink:set-uri req-uri doc))))    
    (else  ; unknown resource type
     (xlink:api-error "resource type not supported: " req-uri)
     #f)))

xlink:unite-duplicate-keys-in-alist

Index
  alist ::= (listof
             (cons key (listof item)))
 For equal keys in the alist, the function unites the corresponding key values
 Returns the new alist
(define (xlink:unite-duplicate-keys-in-alist alist)
  (let loop ((src alist)
             (res '()))
    (if
     (null? src)
     res
     (let ((curr-key (caar src)))
       (let rpt ((scan (cdr src))
                 (content (cdar src))
                 (other '()))
         (cond
           ((null? scan)
            (loop other
                  (cons (cons curr-key content)
                        res)))
           ((equal? (caar scan) curr-key)
            (rpt (cdr scan)
                 (append content (cdar scan))
                 other))
           (else  ; a different key
            (rpt (cdr scan) content
                 (cons (car scan) other)))))))))

xlink:docs-exchange-arcs

Index
 Documents exchange their SXLink arcs, such as each arc is moved to the
 "@@/sxlink/outgoing" branch of the document where the arc's starting
 resource is
 Additional SXLink arcs may be specified in the optional argument.
(define (xlink:docs-exchange-arcs doc-set . sxlink-arcs)
  (let ((doc-set-uris (xlink:uris doc-set))
        (sxlink-arcs (if (null? sxlink-arcs) '() (car sxlink-arcs))))
    ; outgoing-alist ::= (listof
    ;                     (cons uri
    ;                           (listof (cons node (listof sxlink-arc)))))
    ; declared-here-alist ::= (listof
    ;                           (cons uri (listof sxlink-arc)))
    (let loop ((outgoing-alist (map
                                (lambda (doc)
                                  (cons
                                   (xlink:get-uri doc)
                                   (xlink:arcs-outgoing doc)))
                                doc-set))
               (declared-here-alist (map list doc-set-uris))
               (arcs-to-scan
                (append sxlink-arcs
                        (apply append
                               (map xlink:arcs-declared-here doc-set)))))
      (if
       (null? arcs-to-scan)  ; all arcs processed
       (let ((outgoing-alist
              (xlink:unite-duplicate-keys-in-alist outgoing-alist))
             (declared-here-alist
              (xlink:unite-duplicate-keys-in-alist declared-here-alist)))
         (map
          (lambda (doc)
            (let ((uri (xlink:get-uri doc)))
              (xlink:replace-branch               
                doc
                '(@@ sxlink)
                `((declared-here
                   ,@(cdr (assoc uri declared-here-alist)))
                  ,@(if (xlink:arcs-embedded? doc) '((embedded)) '())
                  (outgoing
                   ,@(xlink:unite-duplicate-keys-in-alist
                      (cdr (assoc uri outgoing-alist))))))))
            doc-set))
       (let* ((curr-arc (car arcs-to-scan))
              (uri-from (car  ; URI must be presented
                         ((select-kids (ntype?? '*text*))
                          ((select-kids (ntype?? 'uri))
                           ((select-kids (ntype?? 'from))
                            curr-arc)))))
              (uri-decl (car  ; URI must be presented
                         ((select-kids (ntype?? '*text*))
                          ((select-kids (ntype?? 'uri))
                           ((select-kids (ntype?? 'declaration))
                            curr-arc))))))
         (if
          (not (member uri-from doc-set-uris))
          ; This arc starts from none of the documents from doc-set
          (loop outgoing-alist
                (cons (list uri-decl curr-arc) declared-here-alist)
                (cdr arcs-to-scan))
          (let ((nodes  ; nodes that are the starting resource
                 (let ((nodes-nset
                        ((select-kids (ntype?? 'nodes))
                         ((select-kids (ntype?? 'from))
                          curr-arc))))
                   (if
                    (not (null? nodes-nset))
                    (cdar nodes-nset)
                    (let ((xpointer-nset
                           ((select-kids (ntype?? 'xpointer))
                            ((select-kids (ntype?? 'from)) curr-arc)))
                          (starting-doc (xlink:find-doc uri-from doc-set)))
                      (if
                       (null? xpointer-nset)  ; no XPointer
                       ((select-kids (ntype?? '*))  ; document element
                        starting-doc)
                       (let ((func (sxml:xpointer (cadar xpointer-nset))))
                         (if
                          (not func)  ; parser error
                          #f
                          (let ((starting-nset (func starting-doc)))
                            (if
                             (nodeset? starting-nset)
                             starting-nset
                             #f))))))))))
            (if
              nodes   ; starting resource selects some nodes
              (loop               
               (cons (cons uri-from
                           (map
                            (lambda (node) (list node curr-arc))
                            nodes))
                     outgoing-alist)
               declared-here-alist
               (cdr arcs-to-scan))
              (loop outgoing-alist
                    (cons (list uri-decl curr-arc) declared-here-alist)
                    (cdr arcs-to-scan))))))))))

xlink:parameterized-load-with-respect-documents

Index
 Parameterized with options, returns
  (lambda (linked-docs uri . uris) ...)
 which is the lambda for getting more documents by their URIs
 Options include the following:
  'linkbases - load linkbases recursively
  '(linkbases  <number> ) - load linkbases recursively, with the maximal
                            number of recursive steps defined by the <number>
                            supplied
  'docs - load documents recursively
  '(docs  <number> ) - load documents recursively, with the maximal number
                       of recursive steps defined by the <number> supplied
  'embed - embed SXLink arcs into nodes that are starting resources for that
           arcs
  'no-embed - don't embed SXLink arcs into documents loaded
(define (xlink:parameterized-load-with-respect-documents . options)
  (let ((doc-getter (apply xlink:get-documents-with-params options))
        (embed? (memq 'embed options))
        (no-embed? (memq 'no-embed options)))
    (lambda (linked-docs . uris)
      (let* ((loaded-uris (xlink:uris linked-docs))
             (req-docs
              (xlink:docs-exchange-arcs
               (filter
                (lambda (x) x)
                (map
                 (lambda (uri)
                   (if
                    (member uri loaded-uris)  ; document already loaded
                    (xlink:find-doc uri linked-docs)
                    (xlink:get-document-by-uri uri)))
                 (xlink:remove-equal-duplicates uris)))
               (apply append (map xlink:arcs-declared-here linked-docs)))))
        (cond
          (no-embed? req-docs)
          ((or embed?  ; embed arcs
               (member #t (map xlink:arcs-embedded? linked-docs)))
           (map xlink:embed-arcs-into-document req-docs))
          (else req-docs))))))

xlink:get-docs-with-respect-to-loaded

Index
 The most common case of parametrization
(define xlink:get-docs-with-respect-to-loaded
  (xlink:parameterized-load-with-respect-documents 'linkbase))

xlink:load-linked-docs-with-params

Index
 Parameterized with options, returns
  (lambda (uri . uris) ...)
 which is the lambda for getting documents by their URIs
 Options include the following:
  'linkbases - load linkbases recursively
  '(linkbases  <number> ) - load linkbases recursively, with the maximal
                            number of recursive steps defined by the <number>
                            supplied
  'docs - load documents recursively
  '(docs  <number> ) - load documents recursively, with the maximal number
                       of recursive steps defined by the <number> supplied
  'embed - embed SXLink arcs into nodes that are starting resources for that
           arcs
(define (xlink:load-linked-docs-with-params . options)
  (let ((doc-getter (apply xlink:get-documents-with-params options)))
    (if
     (memq 'embed options)  ; embed
     (lambda (uri . uris)
       (map
        xlink:embed-arcs-into-document
        (xlink:docs-exchange-arcs (apply doc-getter (cons uri uris)))))
     (lambda (uri . uris)
       (xlink:docs-exchange-arcs (apply doc-getter (cons uri uris)))))))

xlink:documents

Index
 procedure xlink:documents :: {REQ-URI}+  -> (listof SXML-TREE)
 procedure xlink:documents-embed :: {REQ-URI}+  -> (listof SXML-TREE)

 Both `xlink:documents' and `xlink:documents-embed' accept one or more
 strings as their arguments. Each string supplied denotes the URI of the
 requested document to be loaded. The requested document(s) are loaded
 and are represented in SXML. All XLink links declared in these document(s)
 are represented as a set of SXLink arcs. If any XLink links refer to XLink
 linkbases [<a href="http://www.w3.org/TR/xlink/#xlg">XLink</a>],
 these linkbases are additionally loaded, for additional SXLink arcs
 declared there.

 The starting resource for each SXLink arc is determined:
 1. For each SXML document loaded, the function `xlink:document' adds all
    SXLink arcs whose starting resource is located within this document, to
    the auxiliary list of its document node (*TOP*).
 2. The function 'xlink:documents-embed' embeds each SXLink arc into its
    starting resource-node, via auxiliary list of that node. For text nodes
    serving for starting resources, their SXLink arcs are stored in the
    auxiliary list of the document node (*TOP*), since SXML text nodes do
    not support their own auxiliary lists.

 Supported URI formats:
  + local file
  + http:// schema

 Supported document formats: XML and HTML. In the case of HTML,
 <A> hyperlinks are considered as XLink simple links.

 Result: (listof SXML-TREE)
 A particular SXML document can be located in this list using the
 function `xlink:find-doc'.
(define xlink:documents
  (xlink:load-linked-docs-with-params 'linkbases))

xlink:documents-embed

Index
(define xlink:documents-embed
  (xlink:load-linked-docs-with-params 'linkbases 'embed))

xlink:arc?

Index
 Whether an SXLink arc
(define xlink:arc?
  (ntype-names??
   '(linkbase simple outbound inbound third-party local-to-local)))

xlink:set-uri

Index
 Sets the URI for the SXML document
(define (xlink:set-uri uri doc)
  (let ((aux-nset ((select-kids (ntype?? '@@)) doc)))
    (if
     (or (null? aux-nset)  ; no aux node at all yet
         ; no sxlink/declared-here subnode
         (null? ((select-kids (ntype?? 'declared-here))
                 ((select-kids (ntype?? 'sxlink)) (car aux-nset)))))
     (xlink:replace-branch  ; inserts the @@/uri node in the document
      doc '(@@ uri) (list uri))
     (xlink:replace-branch
      doc
      '(@@)
      (cdr
       ((xlink:branch-helper  ; inserts URI to sxlink-arcs
         (lambda (declared-here-node dummy)
           (cons
            (car declared-here-node)
            (xlink:set-uri-for-sxlink-arcs
             uri (cdr declared-here-node)))))
        (xlink:replace-branch  ; inserts (modified) URI
         (car aux-nset) '(uri) (list uri))
        '(sxlink declared-here)
        '()  ; dummy
        ))))))

xlink:id-index

Index
 Returns the id-index of the SXML document
 #f is returned is there is no "@@/id-index" subtree in the document
(define (xlink:id-index doc)
  (let ((nodeset ((select-kids (ntype?? 'id-index))
                  ((select-kids (ntype?? '@@)) doc))))
    (if (null? nodeset)  ; there is no "@@/id-index" subtree
        #f
        (cdar nodeset))))

xlink:arcs-declared-here

Index
 Returns (listof sxlink-arc) located in "@@/sxlink/declared-here"
 These are SXLink arcs that are declared in this document
(define (xlink:arcs-declared-here doc)
  ((select-kids (ntype?? '*any*))
   ((select-kids (ntype?? 'declared-here))
    ((select-kids (ntype?? 'sxlink))
     ((select-kids (ntype?? '@@)) doc)))))

xlink:arcs-embedded?

Index
 Whether outgoing SXLink arcs are embedded into the document.
 This is denoted by the presense of "@@/sxlink/embedded" empty element.
(define (xlink:arcs-embedded? doc)
  (not (null? ((select-kids (ntype?? 'embedded))
               ((select-kids (ntype?? 'sxlink))
                ((select-kids (ntype?? '@@)) doc))))))

xlink:arcs-outgoing

Index
 Returns the content of "@@/sxlink/outgoing"
 The result is the associative list between nodes of the document and
 SXLink arcs that start from the corresponding node
(define (xlink:arcs-outgoing doc)
  ((select-kids (ntype?? '*any*))
   ((select-kids (ntype?? 'outgoing))
    ((select-kids (ntype?? 'sxlink))
     ((select-kids (ntype?? '@@)) doc)))))

xlink:arcs-uris

Index
 Returns URIs of resources that participate in SXLink arcs
  sxlink-arcs ::= (listof sxlink-arc)
 Result: (listof string)
 The result may contain duplicates
(define (xlink:arcs-uris sxlink-arcs)
  ((select-kids (ntype?? '*text*))
   ((select-kids (ntype?? 'uri))
    ((select-kids (ntype-names?? '(from to))) sxlink-arcs))))

xlink:arcs-linkbase-uris

Index
 Returns URIs of all linkbases encountered among SXLink arcs
 Result: (listof string)
 The result may contain duplicates
(define (xlink:arcs-linkbase-uris sxlink-arcs)
  ((select-kids (ntype?? '*text*))
   ((select-kids (ntype?? 'uri))
    ((select-kids (ntype?? 'to))
     (filter (ntype?? 'linkbase) sxlink-arcs)))))

xlink:uris

Index
 Returns the list of URIs of the documents in the doc-set
(define (xlink:uris doc-set)
  (filter
   (lambda (x) x)
   (map xlink:get-uri doc-set)))

xlink:remove-equal-duplicates

Index
 Removes equal duplicates from the list
(define (xlink:remove-equal-duplicates lst)
  (cond
    ((null? lst) lst)
    ((member (car lst) (cdr lst))
     (xlink:remove-equal-duplicates (cdr lst)))
    (else
     (cons (car lst) (xlink:remove-equal-duplicates (cdr lst))))))

xlink:find-doc

Index
 procedure xlink:find-doc :: URI-STRING (listof SXML-TREE) -> SXML-TREE

 Finding a document in 'doc-set' by its 'uri-string'.
 If there is no such document, #f is returned.
  doc-set ::= (listof SXML-TREE)
(define (xlink:find-doc uri-string doc-set)
  (let loop ((doc-set doc-set))
    (cond
      ((null? doc-set) #f)
      ((equal? (xlink:get-uri (car doc-set)) uri-string)
       (car doc-set))
      (else (loop (cdr doc-set))))))

xlink:referenced-uris

Index
 Returns a list of URIs which are refered by XLink markup
 Result:  (listof string)
 The list may contain duplicates.
(define (xlink:referenced-uris doc-set)
  (apply append
         (map
          (lambda (doc)
            (xlink:arcs-uris (xlink:arcs-declared-here doc)))
          doc-set)))

xlink:referenced-linkbase-uris

Index
 Returns a list of linkbase URIs which are refered by XLink markup
 Result:  (listof string)
 The list may contain duplicates.
(define (xlink:referenced-linkbase-uris doc-set)
  (apply append
         (map
          (lambda (doc)
            (xlink:arcs-linkbase-uris (xlink:arcs-declared-here doc)))
          doc-set)))

xlink:add-documents-helper

Index
 A helped low-level function for extending the doc-set with more documents
 Is parameterized with
  referenced-uris ::= (lambda (doc-set) ...)
 that would return URIs refered by XLink markup in the doc-set
 When parameterized, returns
  (lambda (doc-set . max-steps) ...)
  max-steps - maximal number of recursive steps
  The lambda returns the expanded doc-set
(define (xlink:add-documents-helper referenced-uris)
  (lambda (doc-set . max-steps)
    (let ((max-steps (if (null? max-steps) -1 (car max-steps))))
      (let loop ((doc-set doc-set)
                 (loaded-uris (xlink:uris doc-set))
                 (to-load (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
                    (referenced-uris added-docs)
                    (+ step 1)))
             ((member (car to-load) loaded-uris)
              (rpt loaded-uris
                   (cdr to-load)
                   added-docs))
             (else   ; we load the linkbase
              (let ((doc (xlink:get-document-by-uri (car to-load))))
                (rpt (cons (car to-load) loaded-uris)
                     (cdr to-load)
                     (if doc (cons doc added-docs) added-docs)))))))))))

xlink:add-linkbases-recursively

Index
 Two most common parameterized functions. The first one recursively loads
 linkbases. The second one recursively loads all refered documents
(define xlink:add-linkbases-recursively
  (xlink:add-documents-helper xlink:referenced-linkbase-uris))

xlink:add-documents-recursively

Index
(define xlink:add-documents-recursively
  (xlink:add-documents-helper xlink:referenced-uris))

xlink:get-documents-with-params

Index
 Parameterized with options, returns
  (lambda (uri . uris) ...)
 which is the lambda for getting documents by their URIs
 Options include the following:
  'linkbases - load linkbases recursively
  '(linkbases  <number> ) - load linkbases recursively, with the maximal
 number of recursive steps defined by the <number> supplied
  'docs - load documents recursively
  '(docs  <number> ) - load documents recursively, with the maximal number
 of recursive steps defined by the <number> supplied
(define (xlink:get-documents-with-params . options)
  (let ((get-initial-docs  ; Returns documents by their URIs
         (lambda (uris)
           (filter  ; keeps only correctly loaded documents
            (lambda (x) x)
            (map xlink:get-document-by-uri
                 (xlink:remove-equal-duplicates uris)))))
        (linkbases-pairs
         (filter
          (lambda (option) (and (pair? option) (eq? (car option) 'linkbases)))
          options))
        (docs-pairs
         (filter
          (lambda (option) (and (pair? option) (eq? (car option) 'docs)))
          options)))
    (let ((linkbases? (or (memq 'linkbases options)
                          (not (null? linkbases-pairs))))
          (max-steps-linkbases (if (null? linkbases-pairs)
                                   -1
                                   (cadar linkbases-pairs)))
          (documents? (or (memq 'docs options)
                          (not (null? docs-pairs))))
          (max-steps-documents (if (null? docs-pairs)
                                   -1
                                   (cadar docs-pairs))))
      (cond
        ((and linkbases? documents?)
         (lambda (uri . uris)
           (xlink:add-linkbases-recursively
            (xlink:add-documents-recursively
             (get-initial-docs (cons uri uris))
             max-steps-documents)
            max-steps-linkbases)))
        (linkbases?
         (lambda (uri . uris)
           (xlink:add-linkbases-recursively            
            (get-initial-docs (cons uri uris))            
            max-steps-linkbases)))
        (documents?
         (lambda (uri . uris)           
           (xlink:add-documents-recursively
            (get-initial-docs (cons uri uris))
            max-steps-documents)))
        (else  ; nothing extra to be loaded
         (lambda (uri . uris) (get-initial-docs (cons uri uris))))))))

xlink:get-documents+linkbases

Index
 The most common parameterized case.
 Loads documents and all linkbases
(define xlink:get-documents+linkbases
  (xlink:get-documents-with-params 'linkbases))

xlink:embed-arcs-into-document

Index
 Takes SXLink arcs outgoing from the document and embeds these arcs into
 element and attribute nodes of the document.
 The modified document is returned
 The function doesn't make a copy of nodes that remain unchanged
(define (xlink:embed-arcs-into-document document)
  (letrec
      (; These helper functions return
       ; (values node outgoing-alist changed?)
       ;  node - the (modified) node
       ;  outgoing-alist ::= (listof (cons node (listof sxlink-arc)))
       ;  changed? - whether the node was changed      
       (process-element-node
        (lambda (node outgoing-alist)
          (cond
            ((or (not (pair? node))
                 (eq? (car node) '@@))
             ; Text node or aux node
             (values node outgoing-alist #f))
            ((eq? (car node) '@)
             (call-with-values
              (lambda ()
                ((process-nodeset process-attribute-node)
                 (cdr node) outgoing-alist))
              (lambda (content new-out-alist changed?)
                (if changed?
                    (values (cons '@ content)
                            new-out-alist
                            changed?)
                    (values node outgoing-alist changed?)))))
            (else  ; this is the element node
             (call-with-values
              (lambda ()
                (cond
                  ((assq node outgoing-alist)
                   => (lambda (alist-member)
                        (values
                         (cdr alist-member)
                         (filter
                          (lambda (memb) (not (eq? memb alist-member)))
                          outgoing-alist))))
                  (else  ; the node is not the starting resource
                   (values #f outgoing-alist))))
              (lambda (outgoing-arcs new-out-alist)
                (call-with-values
                 (lambda () ((process-nodeset process-element-node)
                             (cdr node) new-out-alist))
                 (lambda (content new-out-alist changed?)
                   (cond
                     ((not (or outgoing-arcs changed?))
                      ; node remains unchanged                    
                      (values node outgoing-alist changed?))
                     ((not outgoing-arcs)  ; no arcs from that node
                      (values (cons (car node) content)
                              new-out-alist
                              changed?))
                     (else  ; the node is the starting resource
                      (let ((new-content
                             (if changed? content (cdr node))))
                        (values
                         (cond
                           ((not (null?  ; aux list presented
                                  ((select-kids (ntype?? '@@)) new-content)))
                            (xlink:append-branch
                             (cons (car node) new-content)
                             '(@@ sxlink) outgoing-arcs))
                           (((ntype?? '@)  ; attribute node presented                         
                             (car new-content))
                            `(,(car node)
                              ,(car content)  ; attribute node
                              (@@ (sxlink ,@outgoing-arcs))
                              ,@(cdr content)))
                           (else  ; no attribute node
                            `(,(car node)
                              (@)
                              (@@ (sxlink ,@outgoing-arcs))
                              ,@content)))
                         new-out-alist
                         #t))))))))))))
       (process-attribute-node
        (lambda (node outgoing-alist)
          (cond
            ((assq node outgoing-alist)
             => (lambda (alist-member)
                  (values
                   (if
                    (null?  ; no aux node in the attribute
                     ((select-kids (ntype?? '@@)) node))
                    (append node
                            `((@@
                               (sxlink ,@(cdr alist-member)))))
                    (xlink:append-branch
                     node '(@@ sxlink) (cdr alist-member)))
                   (filter
                    (lambda (memb) (not (eq? memb alist-member)))
                    outgoing-alist)
                   #t)))
            (else   ; the attribute node is not a starting resource
             (values node outgoing-alist #f)))))
       ; Is parameterized with one of the previous functions and
       ; processes the nodeset
       (process-nodeset
        (lambda (processing-func)
          (lambda (nodeset outgoing-alist)
            (let loop ((nset nodeset)
                       (out-alist outgoing-alist)
                       (changed? #f)
                       (res '()))
              (if
               (null? nset)  ; nodeset processed
               (values (reverse res)
                       out-alist
                       changed?)
               (call-with-values
                (lambda () (processing-func (car nset) out-alist))
                (lambda (new-node new-out-alist ch?)
                  (loop (cdr nset)
                        new-out-alist
                        (or changed? ch?)
                        (cons new-node res))))))))))
    (call-with-values
     (lambda () ((process-nodeset process-element-node)
                 (cdr document)
                 (xlink:arcs-outgoing document)))
     (lambda (content new-out-alist changed?)
       (if (not changed?)  ; the document remains unchanged
           (xlink:replace-branch
            document '(@@ sxlink embedded) '())
           (xlink:replace-branch
            (cons '*TOP* content)
            '(@@ sxlink)
            `((declared-here ,@(xlink:arcs-declared-here document))
              (embedded)
              (outgoing ,@new-out-alist))))))))

xlink:arcs-embedded

Index
 Returns all embedded SXLink arcs in the document
 Result: (listof sxlink-arc)
(define (xlink:arcs-embedded doc)
  (let ((get-kids
         (select-kids
          (lambda (node) (and (pair? node) (not (eq? '@@ (car node))))))))
    (let loop ((nodes-to-scan (get-kids doc))
               (res '()))
      (if
       (null? nodes-to-scan)  ; everyone processed
       (draft:remove-eq-duplicates res)
       (loop
        (append (get-kids (car nodes-to-scan)) (cdr nodes-to-scan))
        (append
         ((select-kids (ntype?? '*any*))
          ((select-kids (ntype?? 'sxlink))
           ((select-kids (ntype?? '@@)) (car nodes-to-scan))))
         res))))))

sxml:document

Index
 procedure sxml:document :: REQ-URI [NAMESPACE-PREFIX-ASSIG] ->
                             -> SXML-TREE

 Obtain a [possibly, remote] document by its URI
 Supported URI formats:  local file and HTTP schema
 Supported document formats:  XML and HTML

 REQ-URI - a string that contains the URI of the requested document
 NAMESPACE-PREFIX-ASSIG - is passed as-is to the SSAX parser: there it is
  used for assigning certain user prefixes to certain namespaces.
  NAMESPACE-PREFIX-ASSIG is an optional argument and has an effect for an
  XML resource only. For an HTML resource requested, NAMESPACE-PREFIX-ASSIG
  is silently ignored.

 Result: the SXML representation for the requested document
(define (sxml:document req-uri . namespace-prefix-assig)
  (case (ar:resource-type req-uri)
    ((#f)  ; resource doesn't exist
     (xlink:api-error "resource doesn't exist: " req-uri)
     #f)
    ((xml plain unknown)
     (let* ((port (open-input-resource req-uri))
            (doc (ssax:xml->sxml
                  port
                  (if (null? namespace-prefix-assig)
                      namespace-prefix-assig
                      (car namespace-prefix-assig)))))
       (close-input-port port)
       doc   ; DL: can also add URI: (xlink:set-uri req-uri doc)
       ))
    ((html)
     (let* ((port (open-input-resource req-uri))
            (doc (html->sxml port)))
       (close-input-port port)
       doc   ; DL: can also add URI: (xlink:set-uri req-uri doc)
       ))
    (else  ; unknown resource type
     (xlink:api-error "resource type not supported: " req-uri)
     #f)))

xlink:docs-variable

Index
 Returns the value of the administrative SXPath variable '*docs*
 This variable stores linked-docs
(define (xlink:docs-variable var-binding)
  (cond
    ((assq '*docs* var-binding)
     => cdr)
    (else '())))

xlink:add-docs-to-vars

Index
 Extends var-bindings with administative information about linked-docs
  node - a single node or a nodeset
(define (xlink:add-docs-to-vars node var-binding)
  (if (assq '*docs* var-binding)  ; variable already exists
      var-binding
      (cons
       (cons '*docs*
             (filter
              (lambda (doc)
                (and (draft:top? doc) (xlink:get-uri doc)))
              (draft:reach-root (as-nodeset node))))
       var-binding)))  

xlink:node-embedded-arcs

Index
 Returns SXLink arcs that are embedded into the node as aux list members
 Result: (listof sxlink-arc)
(define (xlink:node-embedded-arcs node)
  (if (draft:top? node)  ; the root node
      '()  ; no embedded arcs
      ((select-kids (ntype?? '*any*))
       ((select-kids (ntype?? 'sxlink))
        ((select-kids (ntype?? '@@)) node)))))

xlink:node-arcs-on-top

Index
 Returns SXLink arcs that are specified at the top-level of the document and
 start from node
(define (xlink:node-arcs-on-top node document)
  (cond
    ((assq node (xlink:arcs-outgoing document))
     => cdr)
    (else '())))

xlink:node-arcs

Index
 Returns all SXLink arcs (both embedded and specified at the top-level) that
 start from ther node
 The union of the two previous functions
(define (xlink:node-arcs node document)
  (append (xlink:node-embedded-arcs node)
          (xlink:node-arcs-on-top node document)))

xlink:traverse-arcs

Index
 Traverse all SXLink arcs to their ending resources
  sxlink-arcs ::= (listof sxlink-arc)
  linked-docs ::= (listof document)
  num-ancestors - number of ancestors required for ending resources
(define (xlink:traverse-arcs sxlink-arcs linked-docs num-ancestors)
  (let* ((arcs-to
          ((select-kids (ntype?? 'to)) sxlink-arcs))
         (req-docs
          (apply
           xlink:get-docs-with-respect-to-loaded
           (cons
            linked-docs
            (if
             (and num-ancestors (zero? num-ancestors))
             ((select-kids (ntype?? '*text*))
              ((select-kids (ntype?? 'uri))
               (filter  ; elements that have a <nodes> subelement
                (lambda (arc-to)
                  (null? ((select-kids (ntype?? 'nodes)) arc-to)))
                arcs-to)))
            ((select-kids (ntype?? '*text*))
             ((select-kids (ntype?? 'uri)) arcs-to)))))))
    ;(pp req-docs)
    (map-union
     (lambda (arc-to)
       (let ((nodes-nset
              ((select-kids (ntype?? 'nodes)) arc-to)))
         (if
          (and num-ancestors (zero? num-ancestors)
               (not (null? nodes-nset)))
          (cadar nodes-nset)
          ; otherwise we need the document and the XPointer node
          (let ((doc (xlink:find-doc
                      (car ((select-kids (ntype?? '*text*))
                            ((select-kids (ntype?? 'uri)) arc-to)))
                      req-docs))
                (xpointer-nset
                 ((select-kids (ntype?? '*text*))
                  ((select-kids (ntype?? 'xpointer)) arc-to))))
            ;(pp doc)            
            ;(display xpointer-nset)
            ;(newline)
            (cond
              ((not doc)  ; document couldn't be loaded
               '())
              ((null? xpointer-nset)
               ; no XPointer part => addresses the document element
               ((draft:child (ntype?? '*) num-ancestors)
                doc))
              (else
               (let ((impl
                      (draft:xpointer (car xpointer-nset)
                                      (if num-ancestors num-ancestors -1))))
                 (if
                  (not impl)  ; parser error
                  '()
                  (let ((res (impl doc)))
                    (if
                     (nodeset? res)
                     res
                     (begin
                       (xlink:api-error
                        "XPointer fragment identifier doesn't "
                        "select any nodeset: " (car xpointer-nset))
                       '())))))))))))
     arcs-to)))

xlink:axis-arc

Index
 XPath+XLink arc axis
 This axis returns all SXLink arcs that start from the context node
  num-ancestors is dummy here, since SXLink arcs don't have ancestors
(define (xlink:axis-arc test-pred? . num-ancestors)
  (let ((this-axis
         (lambda (node)  ; not a nodeset
           (let ((root-node
                  (if (sxml:context? node)
                      (draft:list-last (sxml:context->ancestors-u node))
                      node)))
             (if (draft:top? root-node)
                 (xlink:node-arcs (sxml:context->node node) root-node)
                 (xlink:node-embedded-arcs (sxml:context->node node)))))))
    (lambda (node)   ; node or nodeset
      (filter test-pred?
              (if (nodeset? node)
                  (map-union this-axis node)
                  (this-axis node))))))

xlink:axis-traverse

Index
 XPath+XLink traverse axis
 This axis traverses from the context node
 The lambda produced additionally takes the var-binding. In var-binding, the
 linked-docs can be stored in the administrative variable '*docs*
(define (xlink:axis-traverse test-pred? . num-ancestors)
  (let* ((num-anc (if (null? num-ancestors) 0 (car num-ancestors)))
         (get-arcs  ; returns SXLink arcs that start from a given node
          (lambda (node)  ; not a nodeset
            (let ((root-node
                   (if (sxml:context? node)
                       (draft:list-last (sxml:context->ancestors-u node))
                       node)))
             (if (draft:top? root-node)
                 (xlink:node-arcs (sxml:context->node node) root-node)
                 (xlink:node-embedded-arcs (sxml:context->node node)))))))
    ; node can be both a single node and a nodeset here
    (lambda (node var-binding)
      (filter
       (lambda (node)
         (test-pred? (sxml:context->node node)))       
       (xlink:traverse-arcs
        (if (nodeset? node)
            (map-union get-arcs node)
            (get-arcs node))
        (xlink:docs-variable var-binding)
        num-anc)))))

xlink:axis-traverse-arc

Index
 XPath+XLink traverse-arc axis
 The axis traverses from the context node that is an SXLink arc
 The lambda produced additionally takes the var-binding. In var-binding, the
 linked-docs can be stored in the administrative variable '*docs*
(define (xlink:axis-traverse-arc test-pred? . num-ancestors)
  (let ((num-anc (if (null? num-ancestors) 0 (car num-ancestors))))
    (lambda (node var-binding)
      (filter
       (lambda (node)
         (test-pred? (sxml:context->node node)))       
       (xlink:traverse-arcs
        (filter xlink:arc?
                (draft:reach-root (as-nodeset node)))
        (xlink:docs-variable var-binding)
        num-anc)))))