Merge pull request #12 from eodaGmbH/dev

Dev

.Rbuildignore

@@ -4,3 +4,4 @@
 examples/
 ^README\.Rmd$
 _NAMESPACE
+^data-raw$

DESCRIPTION

@@ -18,4 +18,5 @@ Imports:
     glue,
     htmlwidgets,
     purrr,
+    readr,
     shiny

NAMESPACE

@@ -3,15 +3,18 @@
 export(add_row)
 export(create_columns)
 export(delete_selected_rows)
+export(list_to_data_frame)
 export(redo)
 export(renderTabulator)
 export(set_progress_formatter)
 export(set_star_formatter)
 export(set_tick_cross_formatter)
 export(tabulator)
+export(tabulatorContext)
 export(tabulatorOutput)
 export(tabulator_options)
 export(trigger_download)
 export(trigger_get_data)
+export(trigger_get_spreadsheet_data)
 export(undo)
 import(htmlwidgets)

NEWS.md

@@ -0,0 +1,3 @@
+# rtabulator 0.1.0
+
+* Add NEWS.md to track changes.

R/context_calls.R

@@ -1,10 +1,9 @@
 #' Download table data
-#' @param ctx (\code{\link{tabulatorContext}}): tabulator context
-#' @param type (character): csv or json
+#' @param ctx (\code{\link{tabulatorContext}}): tabulator context object
+#' @param type (character): csv, json or xlsx (needs sheetjs: \code{tabulator(..., sheetjs = TRUE)})
 #' @param file_name (character): file name
 #' @export
-# TODO: Add support for xlsx
-trigger_download <- function(ctx, type = c("csv", "json"), file_name) {
+trigger_download <- function(ctx, type = c("csv", "json", "xlsx"), file_name) {
   invoke_method(ctx, "download", match.arg(type), file_name)
 }
 
@@ -48,3 +47,10 @@ undo <- function(ctx) {
 redo <- function(ctx) {
   invoke_method(ctx, "redo")
 }
+
+#' Submit data to R
+#' @inheritParams trigger_download
+#' @export
+trigger_get_spreadsheet_data <- function(ctx) {
+  invoke_method(ctx, "getSpreadsheetData")
+}

R/js_dependencies.R

@@ -0,0 +1,12 @@
+SHEETJS_VERSION <- "0.20.1"
+
+# Needed to support xlsx downloads
+sheetjs_dependency <- htmltools::htmlDependency(
+  name = "sheetjs",
+  version =SHEETJS_VERSION,
+  src = list(
+    href = glue::glue("https://cdn.sheetjs.com/xlsx-{SHEETJS_VERSION}/package/dist/")
+  ),
+  script = "xlsx.mini.min.js",
+  all_files = FALSE
+)

R/tabulator.R

@@ -1,33 +1,60 @@
-#' <Add Title>
-#'
-#' <Add Description>
+#' Create a Tabulator Widget
 #'
+#' @param data (data.frame, character or list): In spreadsheet mode data needs to be a list or \code{NULL}
+#'  for an empty spreadsheet.
+#' @param options (list): Setup options. See \code{\link{tabulator_options}}.
+#' @param editable (bool): Whether the table is editable.
+#' @param sheetjs (bool): Whether to add sheetjs (\url{https://sheetjs.com/}) dependency,
+#'  which is needed for xlsx downloads.
+#' @param theme (character): Theme to apply to the table.
+#' @param width Width of the widget.
+#' @param height Height of the widget.
+#' @param element_id description
+#' @param ... Named arguments that are appended to the \code{options} parameter.
 #' @import htmlwidgets
-#'
 #' @export
-tabulator <- function(data, options = tabulator_options(),
-                      rtabulator_auto_columns = TRUE,
-                      editable = FALSE,
-                      width = NULL, height = NULL, elementId = NULL, ...) {
+tabulator <- function(
+    data,
+    options = tabulator_options(),
+    editable = FALSE,
+    sheetjs = FALSE,
+    theme = c("default", "midnight", "modern", "simple", "site", "bootstrap3", "bootstrap4", "bootstrap5", "bulma", "materialize", "semanticui"),
+    width = NULL,
+    height = NULL,
+    element_id = NULL,
+    ...) {
   if (is.null(options)) options <- list()
 
+  if (class(data) == "character") {
+    data <- readr::read_csv(data, show_col_types = FALSE)
+  }
+
   options <- utils::modifyList(options, list(...))
   if (isTRUE(options$spreadsheet)) {
     # ...
   } else {
     data <- fix_colnames(data)
-    if (rtabulator_auto_columns && is.null(options$columns)) {
+    if (getOption("rtabulator.auto_columns", TRUE) && is.null(options$columns)) {
       options$columns <- create_columns(data, editor = editable)
     }
 
     data <- set_auto_id(data)
   }
 
+  theme <- match.arg(theme)
+  stylesheet_text <- ifelse(theme == "default", NA, read_tabulator_theme(theme))
+
   x <- list(
     data = data,
-    options = keys_to_camel_case(compact(options))
+    options = keys_to_camel_case(compact(options)),
+    stylesheetText = stylesheet_text
   )
 
+  dependencies <- list()
+
+  if (sheetjs) {
+    dependencies <- c(dependencies, list(sheetjs_dependency))
+  }
 
   # create widget
   htmlwidgets::createWidget(
@@ -36,7 +63,8 @@ tabulator <- function(data, options = tabulator_options(),
     width = width,
     height = height,
     package = "rtabulator",
-    elementId = elementId
+    dependencies = dependencies,
+    elementId = element_id
   )
 }
 

R/tabulator_context.R

@@ -14,6 +14,10 @@ invoke_method <- function(widget, method_name, ...) {
   invisible(widget)
 }
 
+#' Create a Tabulator Context
+#' @param output_id (character): A tabulator output id.
+#' @param session shiny session object
+#' @export
 tabulatorContext <- function(output_id, session = shiny::getDefaultReactiveDomain()) {
   ctx <- list(
     id = output_id,

R/tabulator_options.R

@@ -1,9 +1,21 @@
 #' Table Options
-#' https://tabulator.info/docs/6.2/options
+#' @param height (character) The height of the table in px.
+#' @param history (bool): description
+#' @param colummns (list): description
+#' @param layout (character): ...
+#' @param responsive_layout (bool): description
+#' @param movable_columns (bool): description
+#' @param header_visible (bool): description
+#' @param row_height description
+#' @param add_row_pos (character): description
+#' @param movable_rows (bool): description
+#' @param resizable_rows (bool): description
+#' @param frozen_rows description
+#' @seealso \url{https://tabulator.info/docs/6.2/options}
 #' @export
 tabulator_options <- function(
     # General
-    height = NULL,
+    height = "311px",
     history = FALSE, # Must be TRUE in order to use 'undo' and 'redo'
     # Columns
     columns = NULL,
@@ -34,6 +46,8 @@ tabulator_options <- function(
     spreadsheet_rows = NULL,
     spreadsheet_columns = NULL,
     spreadsheet_column_definition = list(editor = "input"),
+    spreadsheet_sheets = NULL,
+    spreadsheet_sheet_tabs = NULL,
     ...) {
   params <- as.list(environment())
   params$layout <- match.arg(layout)

R/themes.R

@@ -0,0 +1,9 @@
+read_tabulator_theme <- function(
+    theme = c("midnight", "modern", "simple", "site", "bootstrap3", "bootstrap4", "bootstrap5", "bulma", "materialize", "semanticui")) {
+  theme <- match.arg(theme)
+  file_name <- system.file(
+    glue::glue("htmlwidgets/libs/tabulator/tabulator_{theme}.min.css"),
+    package = "rtabulator"
+  )
+  return(readr::read_file(file_name))
+}

R/utils.R

@@ -10,3 +10,9 @@ keys_to_camel_case <- function(x) {
 compact <- function(x) {
   x[!sapply(x, is.null)]
 }
+
+#' @export
+list_to_data_frame <- function(x) {
+  # jsonlite::toJSON(x, auto_unbox = TRUE) |> jsonlite::fromJSON()
+  return(do.call(rbind.data.frame, x))
+}

data-raw/DATASET.R

@@ -0,0 +1,6 @@
+## code to prepare `DATASET` dataset goes here
+
+url <- "https://raw.githubusercontent.com/datasciencedojo/datasets/master/titanic.csv"
+download.file(url, "data-raw/titanic.csv")
+
+# usethis::use_data(DATASET, overwrite = TRUE)