Feature/set column

NAMESPACE

@@ -3,6 +3,19 @@
 export(add_row)
 export(delete_selected_rows)
 export(for_each_col)
+export(formatter_color)
+export(formatter_datetime)
+export(formatter_html)
+export(formatter_image)
+export(formatter_link)
+export(formatter_money)
+export(formatter_plaintext)
+export(formatter_progress)
+export(formatter_star)
+export(formatter_textarea)
+export(formatter_tick_cross)
+export(formatter_toggle_switch)
+export(formatter_traffic_light)
 export(modify_col_def)
 export(redo)
 export(renderTabulator)
@@ -11,6 +24,7 @@ export(set_column_defaults)
 export(set_column_editor_input)
 export(set_column_editor_numeric)
 export(set_column_editor_text_area)
+export(set_columns)
 export(set_editor)
 export(set_formatter_color)
 export(set_formatter_datetime)

R/column-editors.R

@@ -18,9 +18,9 @@ set_column_editor_input <- function(widget,
                                     select_contents = TRUE,
                                     elementAttributes = list(
                                       maxlength = 10
-                                    )){
-  editor = "input"
-  editorParams = list(
+                                    )) {
+  editor <- "input"
+  editorParams <- list(
     search = search,
     mask = mask,
     selectContents = select_contents,
@@ -49,10 +49,9 @@ set_column_editor_text_area <- function(widget,
                                         mask = "",
                                         select_contents = TRUE,
                                         vertical_navigation = "editor",
-                                        shift_enter_submit = TRUE
-){
-  editor = "textarea"
-  editorParams = list(
+                                        shift_enter_submit = TRUE) {
+  editor <- "textarea"
+  editorParams <- list(
     elementAttributes = elementAttributes,
     mask = mask,
     selectContents = select_contents,
@@ -76,19 +75,18 @@ set_column_editor_text_area <- function(widget,
 #' @export
 #'
 set_column_editor_numeric <- function(widget,
-                                        columns,
-                                        min = 0,
-                                        max = 100,
-                                        step = 1,
-                                        elementAttributes = list(
-                                          maxlength = 10
-                                        ),
-                                        mask = "",
-                                        select_contents = TRUE,
-                                        vertical_navigation = "table"
-){
-  editor = "number"
-  editorParams = list(
+                                      columns,
+                                      min = 0,
+                                      max = 100,
+                                      step = 1,
+                                      elementAttributes = list(
+                                        maxlength = 10
+                                      ),
+                                      mask = "",
+                                      select_contents = TRUE,
+                                      vertical_navigation = "table") {
+  editor <- "number"
+  editorParams <- list(
     min = min,
     max = max,
     elementAttributes = elementAttributes,
@@ -99,5 +97,3 @@ set_column_editor_numeric <- function(widget,
 
   set_column_editor(widget, columns, editor, editorParams)
 }
-
-

R/column-formatters.R

@@ -8,6 +8,7 @@
 #' @example examples/formatters/formatter_html.R
 #' @export
 set_formatter_html <- function(widget, columns, hoz_align = c("left", "center", "right")) {
+  if (!testthat::is_testing()) .Deprecated("formatter_html")
   col_update <- list(formatter = "html", hozAlign = match.arg(hoz_align))
   modify_col_def(widget, columns, col_update)
 }
@@ -19,6 +20,7 @@ set_formatter_html <- function(widget, columns, hoz_align = c("left", "center",
 #'   set_formatter_plaintext("Species", hoz_align = "right")
 #' @export
 set_formatter_plaintext <- function(widget, columns, hoz_align = "left") {
+  if (!testthat::is_testing()) .Deprecated("formatter_plaintext")
   col_update <- list(formatter = "plaintext", hozAlign = hoz_align)
   modify_col_def(widget, columns, col_update)
 }
@@ -28,6 +30,7 @@ set_formatter_plaintext <- function(widget, columns, hoz_align = "left") {
 #' @example examples/formatters/formatter_textarea.R
 #' @export
 set_formatter_textarea <- function(widget, columns, hoz_align = "left") {
+  if (!testthat::is_testing()) .Deprecated("formatter_textarea")
   col_update <- list(formatter = "textarea", hozAlign = hoz_align)
   modify_col_def(widget, columns, col_update)
 }
@@ -57,6 +60,7 @@ set_formatter_money <- function(
     precision = FALSE,
     hoz_align = "left") {
   # Body
+  if (!testthat::is_testing()) .Deprecated("formatter_money")
   col_update <- list(
     formatter = "money",
     formatterParams = list(
@@ -91,6 +95,7 @@ set_formatter_image <- function(
     url_suffix = NULL,
     hoz_align = "center") {
   # Body
+  if (!testthat::is_testing()) .Deprecated("formatter_image")
   col_update <- list(
     formatter = "image",
     formatterParams = compact(list(
@@ -123,6 +128,7 @@ set_formatter_link <- function(
     target = "_blank",
     hoz_align = "left") {
   # Body
+  if (!testthat::is_testing()) .Deprecated("formatter_link")
   col_update <- list(
     formatter = "link",
     formatterParams = compact(list(
@@ -146,6 +152,7 @@ set_formatter_star <- function(widget, columns, number_of_stars = NA, hoz_align
   if (is.na(number_of_stars)) {
     number_of_stars <- max(widget$x$data[columns])
   }
+  if (!testthat::is_testing()) .Deprecated("formatter_star")
 
   col_update <- list(
     formatter = "star",
@@ -180,6 +187,7 @@ set_formatter_progress <- function(
     legend_color = "#000000",
     legend_align = c("center", "left", "right", "justify"),
     hoz_align = "left") {
+  if (!testthat::is_testing()) .Deprecated("formatter_progress")
   # Body
   if (is.na(min)) {
     min <- min(widget$x$data[columns])
@@ -209,6 +217,7 @@ set_formatter_progress <- function(
 #' @example examples/formatters/formatter_tick_cross.R
 #' @export
 set_formatter_tick_cross <- function(widget, columns, hoz_align = "center") {
+  if (!testthat::is_testing()) .Deprecated("formatter_tick_cross")
   col_update <- list(formatter = "tickCross", hozAlign = hoz_align)
   modify_col_def(widget, columns, col_update)
 }
@@ -235,6 +244,7 @@ set_formatter_toggle_switch <- function(
     off_color = "red",
     clickable = TRUE) {
   # Body
+  if (!testthat::is_testing()) .Deprecated("formatter_toggle_switch")
   col_update <- list(
     formatter = "toggle",
     formatterParams = list(
@@ -271,6 +281,7 @@ set_formatter_datetime <- function(
     invalid_placeholder = "(invalid datetime)",
     timezone = NA,
     hoz_align = "left") {
+  if (!testthat::is_testing()) .Deprecated("formatter_datetime")
   # Body
   col_update <- list(
     formatter = "datetime",
@@ -290,6 +301,7 @@ set_formatter_datetime <- function(
 #' @example examples/formatters/formatter_color.R
 #' @export
 set_formatter_color <- function(widget, columns) {
+  if (!testthat::is_testing()) .Deprecated("formatter_color")
   col_update <- list(formatter = "color")
   modify_col_def(widget, columns, col_update)
 }
@@ -305,6 +317,7 @@ set_formatter_traffic_light <- function(
     max = NA,
     color = c("green", "orange", "red"),
     hoz_align = "center") {
+  if (!testthat::is_testing()) .Deprecated("formatter_traffic_light")
   # Body
   if (is.na(min)) min <- min(widget$x$data[columns])
 

R/columns.R

@@ -1,3 +1,75 @@
+#' Set column definitions
+#'
+#' @param widget A [tabulator()] HTML widget.
+#' @param columns The names of the columns the formatter is applied to.
+#' @param title A title that will be displayed for the columns.
+#' @param formatter A formatter definition as generated by a `formatter_*()` function
+#' @param hoz_align (character): The horizontal alignment of the column.
+#' @param ... You can add arguments that will be passed on as updates to the column definition.
+#' Checkout the documentation at \url{https://tabulator.info/docs/}
+#' @returns The updated [tabulator()] HTML widget
+#' @example examples/formatters/formatter_html.R
+#' @export
+set_columns <- function(widget,
+                        columns,
+                        title = NULL,
+                        formatter = NULL,
+                        # TODO editor = NULL,
+                        # TODO validator = NULL,
+                        hoz_align = NULL,
+                        ...) {
+  if (is.null(hoz_align) & !is.null(formatter)) {
+    hoz_align <- switch(formatter$formatter,
+      image = "center",
+      star = "center",
+      progress = "left",
+      tickCross = "center",
+      traffic = "center",
+      "left"
+    )
+  }
+
+  if (!is.null(formatter)) {
+    # Handling of missing parameters
+    if (formatter$formatter %in% "star") {
+      if (is.na(formatter$formatterParams$stars)) {
+        message("Parameter number_of_stars not set in formatter, using max value of data to determine number of stars. See ?formatter_star for more information.")
+        formatter$formatterParams$stars <- max(widget$x$data[columns], na.rm = T)
+      }
+    }
+    if (formatter$formatter %in% c("progress", "traffic")) {
+      if (is.na(formatter$formatterParams$min)) {
+        message("Parameter min not set in formatter, using min value of data.")
+        formatter$formatterParams$min <- min(widget$x$data[columns], na.rm = T)
+      }
+      if (is.na(formatter$formatterParams$max)) {
+        message("Parameter max not set in formatter, using max value of data.")
+        formatter$formatterParams$max <- max(widget$x$data[columns], na.rm = T)
+      }
+    }
+
+    # Handling of missing dependencies
+    if (formatter$formatter == "datetime" & !"luxon" %in% names(widget$dependencies)) {
+      warning("You need to enable the luxon dependency. Checkout `help(formatter_datetime)` for more hints.")
+    }
+  }
+
+  # Create update for column definition
+
+  col_update <- list()
+  col_update$hozAlign <- hoz_align
+  col_update$title <- title
+  col_update <- col_update |>
+    append(formatter) |>
+    # append(editor) |>
+    # append(validator) |>
+    append(list(...))
+
+  modify_col_def(widget, columns, col_update)
+}
+
+
+
 # #' Create column definitions from data
 # #' @param data (data.frame) data
 # #' @param editor (bool): Whether to make columns editable.
@@ -249,11 +321,11 @@ set_calculation <- function(
 #' @export
 #' @examples
 #'
-#' df <- data.frame(values = c(1,2,3), names = c("a","b","c"))
+#' df <- data.frame(values = c(1, 2, 3), names = c("a", "b", "c"))
 #' tabulator(df) |>
-#'   modify_col_def(c("values","names"),
-#'   col_update = list(hozAlign = "center"))
-
+#'   modify_col_def(c("values", "names"),
+#'     col_update = list(hozAlign = "center")
+#'   )
 modify_col_def <- function(widget, columns, col_update) {
   for (column in columns) {
     for (index in 1:length(widget$x$options$columns)) {