https://github.com/cran/XML
Tip revision: ccb805f005c1c130824a03bd6209c69841d26d79 authored by Duncan Temple Lang on 17 January 2012, 00:00:00 UTC
version 3.9-4
version 3.9-4
Tip revision: ccb805f
DTD.R
dtdIsAttribute <-
function(name, element, dtd)
{
if(!inherits(element,"XMLElementDef")) {
element <- dtdElement(as.character(element), dtd)
}
# return(!is.na(amatch(name, names(element$attributes))))
return(!is.na(match(name, names(element$attributes))))
}
dtdValidElement <-
#
# checks whether an XML element named `name'
# can be inserted into an element named `within'
# as defined in the specific DTD, optionally
# specifying the position the `name' element would
# be added.
#
# Ideally, this would be used when writing to an XML stream
# (doesn't exist in R or S, yes).
# The stream would monitor the currently open tags
# (as a stack) and would be able to test whether a new
# insertion was valid.
function(name, within, dtd, pos=NULL)
{
el <- dtdElement(within, dtd)
if(is.null(el))
stop(paste("No such element \"",within,"\" in DTD",sep="", collapse=""))
return(dtdElementValidEntry(el, name,pos=pos))
}
dtdElementValidEntry <-
function(element, name, pos=NULL)
{
UseMethod("dtdElementValidEntry", element) # , name, pos)
}
dtdElementValidEntry.XMLElementDef <-
function(element, name, pos=NULL)
{
return(dtdElementValidEntry(element$contents,name,pos=pos))
}
dtdElementValidEntry.XMLOrContent <-
function(element, name, pos=NULL)
{
for(i in element$elements) {
if(dtdElementValidEntry(i, name, pos=pos))
return(TRUE)
}
return(FALSE)
}
dtdElementValidEntry.XMLElementContent <-
function(element, name, pos=NULL)
{
# if there are no sub-element types, then can't be here.
# Might check this is a PCDATA by looking at the type.
if(is.null(element$elements)) {
return(FALSE)
}
return( any(element$elements == name) )
}
dtdElementValidEntry.character <-
function(element, name, pos=NULL)
{
return(element == name)
}
dtdElementValidEntry.XMLSequenceContent <-
function(element, name, pos=NULL)
{
if(!is.null(pos)) {
tmp <- element$elements[[as.integer(pos)]]
if(!is.null(tmp))
return(dtdElementValidEntry(tmp))
else
return(FALSE)
}
for(i in element$elements) {
if(dtdElementValidEntry(i, name)) {
return(TRUE)
}
}
return(FALSE)
}
xmlContainsEntity <-
#
# Determine if a particular entity is defined
# within the DTD.
#
function(name, dtd)
{
return(!is.na(match(name,dtd$entities)))
}
xmlContainsElement <-
#
# Determine if a particular entity is defined
# within the DTD.
#
function(name, dtd)
{
return(!is.na(match(name,dtd$element)))
}
dtdEntity <-
#
# Retrieves the specified entity from the DTD definition.
# Uses the `dtd$entitities' list.
#
function(name, dtd)
{
dtd$entities[[name]]
}
dtdElement <-
#
# Retrieves the specified element from the DTD definition.
# Uses the `dtd$elements' list.
function(name, dtd)
{
dtd$elements[[name]]
}