R/attr.R

Defines functions restore strip find_attr strip_attr

strip_attr <- function(x,.f,env){
  
  if(is.null(get(toupper(.f),envir = env)))
    return(x)
  
  .fn <- get(sprintf('strip_%s',.f),envir = asNamespace('texblocks')) 
  .fn(x)
}

find_attr  <- function(x,.f,env = NULL){
  .fn <- get(sprintf('find_%s',.f),envir = asNamespace('texblocks'))
  if(!is.null(env))
    assign(toupper(.f),.fn(x),envir = env)
}

strip <- function(x,env){
  
  x <- strip_tabular(x)
  
  find_attr(x,'hline',env)
  find_attr(x,'cline',env)
  
  x <- strip_attr(x,'hline',env)
  x <- strip_attr(x,'cline',env)
  
  find_attr(x,'multicol',env)
  find_attr(x,'multirow',env)
  
  x <- strip_attr(x,'multicol',env)
  x <- strip_attr(x,'multirow',env)
  
  x
}

#'@importFrom  purrr discard
restore <- function(x,env){
  
  l <-   as.list(env)%>%
    purrr::discard(is.null)
  
  if(length(l)>0){
    
    for(nm in names(l)){
      attr(x,nm) <- l[[nm]]
    }
    
  }
  x
}
metrumresearchgroup/texblocks documentation built on July 18, 2020, 1:45 a.m.