Nothing
#' Associate relative documentation comments
#'
#' Relative comment created with \code{\#\<} comment tags document something
#' designated by the location of the comment.
#' In general, the comment documents the previous symbol.
#' A comment will not be associated with any parse id that does not have
#' the same parent as the comment. For example,
#'
#' function(x #< a valid comment
#' ){}
#'
#' would associate \code{a valid comment} with \code{x}, but
#'
#' function(x){ #< not a valid comment
#' }
#'
#' would not.
#'
#' @return Returns a vector of the same length as id. Where the value is
#' either the id of the associated object or NA if it cannot be
#' associated.
pd_get_relative_comment_associated_ids <-
function( id, pd, .check=TRUE){
#' @inheritParams pd_get_children_ids
if (.check){
pd <- ._check_parse_data(pd)
id <- ._check_id(id, pd)
stopifnot( all(pd_is_relative_comment(id, pd)))
}
if (length(id)>1L) return(sapply(id, pd_get_relative_comment_associated_ids, pd=pd))
sibs <- siblings(id, pd)
possible <- sibs[token(sibs, pd) == 'SYMBOL_FORMALS']
if (length(possible) == 0L) return(NA)
possible <- possible[end_line(possible) <= start_line(id)]
if (length(possible)==1L) return(possible)
if (length(possible) == 0L) return(NA)
possible <- possible[end_line(possible) == max(end_line(possible))]
possible <- possible[end_col(possible) == max(end_col(possible))]
stopifnot(length(possible) == 1)
return(possible)
}
relative_comment_associateds <- internal(pd_get_relative_comment_associated_ids)
if(FALSE){#@test function relative comments
pd <- get_parse_data(parse(text='function( pd #< parse data
#< continuation comment
, id = pd_all_root_ids(pd) #< id number
){}', keep.source=TRUE))
id <- all_relative_comment_ids(pd)
value <- pd_get_relative_comment_associated_ids(id, pd)
expect_identical(value[[1]], value[[2]])
expect_identical(text(value, pd=pd), c('pd', 'pd', 'id'))
# while one argument documented and another not should be discouraged,
# it is allowed.
pd <- get_parse_data(parse(text='function( id, pd = get("pd", parent.frame()) #< parse data
){}', keep.source=TRUE))
id <- all_relative_comment_ids(pd)
expect_identical(text(pd_get_relative_comment_associated_ids(id, pd), pd=pd), 'pd')
pd <- get_parse_data(parse(text='function( id, #< traditional comma placement.
pd = get("pd", parent.frame()) #< parse data
){}', keep.source=TRUE))
id <- all_relative_comment_ids(pd)
value <- pd_get_relative_comment_associated_ids(id, pd)
expected <- pd[ token(pd$id, pd=pd) == "SYMBOL_FORMALS"
& text(pd$id, pd=pd) %in% c("pd", "id")
, 'id']
expect_identical(value, expected)
}
if(FALSE){#@test class members
pd <- get_parse_data(parse(text='
classDef <- setClass( "testClass"
, slots = c( x="numeric" #< the x field
, y="matrix" #< the y field
)
)', keep.source=TRUE))
ids <- all_relative_comment_ids(pd)
id <- ids[[1]]
expect_true(pd_is_in_class_definition(id,pd))
expect_identical( pd_is_in_class_definition(ids,pd), c(TRUE, TRUE))
expect_false(pd_is_in_class_definition(.find_text('classDef',pd), pd))
}
if(FALSE){#@test no possible relative.
pd <- get_parse_data(parse(text='
#< not a valid relative comment.
function( #< also not valid
pd #< continuation comment
, id = pd_all_root_ids(pd) #< id number
){}', keep.source=TRUE))
id <- all_relative_comment_ids(pd)[[1]]
expect_true(is.na(pd_get_relative_comment_associated_ids(id, pd)))
id <- all_relative_comment_ids(pd)[[2]]
expect_true(is.na(pd_get_relative_comment_associated_ids(id, pd)))
}
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.