R/getListFromDir.R

noNULLs <- function(l) {
    l[!sapply(l, is.null)]
}

add_s <- function(n) {
  ifelse(n > 1, "s", "")
}

dir_desc <- function(n_dirs, n_files) {
  msg <- ifelse(n_dirs > 0, sprintf("%s folder%s", n_dirs, add_s(n_dirs)), "")
  if (n_files > 0) {
    file_msg <- sprintf("%s file%s", n_files, add_s(n_files))
    if (n_dirs > 0) { 
      msg <- paste0(msg, ", ", file_msg) 
    } else {
      msg <- file_msg
    }
  }
  msg
}

#' Get a file and directory list for ShinyFileTree
#' @export
get_list_from_directory <- function(my_dir, pattern = NULL, 
                                    hide_empty_dirs = FALSE, 
                                    show_hidden_files = FALSE,
                                    show_dir_info = FALSE,
                                    state = NULL, 
                                    simplify = FALSE,
                                    max_depth = 10) {
  all_dirs <- list.dirs(my_dir, recursive = FALSE, full.names=TRUE)
  all_files <- list.files(my_dir, pattern = pattern, full.names = TRUE)
  if (!isTRUE(show_hidden_files)) {
    all_dirs <- all_dirs[!grepl("/\\.", all_dirs)]
    all_files <- all_files[!grepl("/\\.", all_files)]
  }
  all_files <- all_files[!all_files %in% all_dirs]
  
  if (length(all_files) == 0 && length(all_dirs) == 0)
    return()
 
  all_dirs <- lapply(all_dirs,function(x) {
    name <- basename(x)  
    if (is.null(max_depth) || max_depth >= 1) {
      if (!is.null(max_depth))
        max_depth <- max_depth - 1
      
      children <- get_list_from_directory(x, pattern, 
                                          hide_empty_dirs=hide_empty_dirs, 
                                          show_hidden_files=show_hidden_files,
                                          show_dir_info=show_dir_info,
                                          state=state, max_depth = max_depth)
      if (hide_empty_dirs && (is.null(children) || length(children) == 0))
        return(NULL)
      if (!is.null(attr(children,"dirname", exact = T))) {
        name <- sprintf("%s <i><small>%s</small></i>", basename(name), attr(children,"dirname", exact = T))
        attr(children,"dirname") <- NULL
      }
      if (!is.null(max_depth) && max_depth == 0) {
        children <- NULL
      }
    } else {
      children <- NULL
    }
    
    if (!isTRUE(simplify)) {
    noNULLs(list(text = name,
         type = 'directory',
         state = state,
         children = children))
    } else {
      c(x, children)
    }
  }) 
  
  #all_dirs <- all_dirs[!sapply(all_dirs,is.null)]
  if (isTRUE(simplify)) {
    all_dirs <- unlist(all_dirs)
  } else {
    all_files <- lapply(seq_along(all_files), function(i) {
        if (isTRUE(show_dir_info)) {
          list(text = sprintf("%s <i><small>%s</small></i>", basename(all_files[i]), 
                              tryCatch({ utils:::format.object_size(file.size(all_files[i]), "auto")},
                                  error = function(...) {} )), type = 'file')
        } else {
          list(text = basename(all_files[i]), type = 'file')
        }
    })
  }

  res <- c(all_dirs, all_files)
  if (isTRUE(show_dir_info)) {
    msg <- dir_desc(length(all_dirs), length(all_files))
    attr(res, "dirname") <- msg
  }
  res
}

is_empty <- function(x) {
  is.null(x) | (is.list(x) && x$type == "directory" && is.null(x$children) && length(x) == 2)
}

prune_empty_directories <- function(x) {
  stop("Function not working")
  x <- Filter(Negate(is_empty), x)
  lapply(x, function(y) if (is.list(y)) prune_empty_directories(y) else y)
}

startsWith <- function(x,y) {
  stopifnot(length(y) == 1)
  grepl(sprintf("^%s",y),x)
}

get_list_from_directory_ajax <- function(my_dir,open_path) {
  all_dirs <- list.dirs(my_dir, recursive = FALSE, full.names=TRUE)
  all_files <- list.files(my_dir)
  all_files <- all_files[!all_files %in% sub(".*/","",all_dirs)]
  if (length(all_files) == 0 && length(all_dirs) == 0)
    return()
  
  if (startsWith(open_path,my_dir)) {
  c(
    lapply(all_dirs,function(x)
      list(text=sub(".*/","",x),
           children=get_list_from_directory_ajax(x,open_path))),
    lapply(all_files,function(x) list(text=x,type='file')))
  } else {
    c(
      lapply(all_dirs,function(x)
        list(text=sub(".*/","",x), children="loading ...")),
      lapply(all_files,function(x) list(text=x,type='file')))
  }

}
fbreitwieser/shinyFileTree documentation built on May 16, 2019, 12:03 p.m.