[comment] export wb_get_comment() (#956)

* [comment] export wb_get_comment()

* [thread] export wb_get_thread()

NAMESPACE

@@ -91,6 +91,7 @@ export(wb_get_base_colors)
 export(wb_get_base_colours)
 export(wb_get_base_font)
 export(wb_get_cell_style)
+export(wb_get_comment)
 export(wb_get_creators)
 export(wb_get_named_regions)
 export(wb_get_order)
@@ -100,6 +101,7 @@ export(wb_get_selected)
 export(wb_get_sheet_names)
 export(wb_get_sheet_visibility)
 export(wb_get_tables)
+export(wb_get_thread)
 export(wb_grid_lines)
 export(wb_group_cols)
 export(wb_group_rows)

R/class-comment.R

@@ -36,12 +36,12 @@ wbComment <- R6::R6Class(
     #' @param height Height of comment in ... units
     #' @return a `wbComment` object
     initialize = function(text, author, style, visible, width, height) {
-      self$text <- text
-      self$author <- author
-      self$style <- style
+      self$text    <- text
+      self$author  <- author
+      self$style   <- style
       self$visible <- visible
-      self$width <- width
-      self$height <- height
+      self$width   <- width
+      self$height  <- height
       invisible(self)
     },
 
@@ -111,12 +111,14 @@ wbComment <- R6::R6Class(
 #' c3 <- wb_comment(text = c("This Part Bold red\n\n", "This part black"), style = c(s1, s2))
 #'
 #' wb$add_comment(sheet = 1, dims = wb_dims(3, 6), comment = c3)
-wb_comment <- function(text = NULL,
-                       style = NULL,
-                       visible = FALSE,
-                       author = getOption("openxlsx2.creator"),
-                       width = 2,
-                       height = 4) {
+wb_comment <- function(
+    text    = NULL,
+    style   = NULL,
+    visible = FALSE,
+    author  = getOption("openxlsx2.creator"),
+    width   = 2,
+    height  = 4
+) {
   # Code copied from the wbWorkbook
   author <- author %||% Sys.getenv("USERNAME", unset = Sys.getenv("USER"))
   text <- text %||% ""
@@ -127,18 +129,17 @@ wb_comment <- function(text = NULL,
   assert_class(visible, "logical")
 
   if (length(visible) > 1) stop("visible must be a single logical")
-  if (length(author) > 1) stop("author) must be a single character")
-  if (length(width) > 1) stop("width must be a single integer")
-  if (length(height) > 1) stop("height must be a single integer")
+  if (length(author) > 1)  stop("author) must be a single character")
+  if (length(width) > 1)   stop("width must be a single integer")
+  if (length(height) > 1)  stop("height must be a single integer")
 
-  width <- round(width)
+  width  <- round(width)
   height <- round(height)
 
   if (is.null(style)) {
     style <- create_font()
   }
 
-  author <- replace_legal_chars(author)
   # if text was created using fmt_txt()
   if (inherits(text, "fmt_txt")) {
     text  <- text
@@ -147,7 +148,7 @@ wb_comment <- function(text = NULL,
     text <- replace_legal_chars(text)
   }
 
-
+  author <- replace_legal_chars(author)
   if (author != "") {
     # if author is provided, we write additional lines with the author name as well as an empty line
     text <- c(paste0(author, ":"), "\n", text)
@@ -465,55 +466,10 @@ remove_comment <- function(
 
 }
 
-
-
 as_fmt_txt <- function(x) {
   vapply(x, function(y) {
     ifelse(is_xml(y), si_to_txt(xml_node_create("si", xml_children = y)), y)
   },
   NA_character_
   )
 }
-
-wb_get_comment <- function(wb, sheet = current_sheet(), dims = "A1") {
-
-  sheet_id <- wb$validate_sheet(sheet)
-  cmmt <- wb$worksheets[[sheet_id]]$relships$comments
-
-  cmts <- list()
-  if (length(cmmt) && length(wb$comments) <= cmmt) {
-    cmts <- as.data.frame(do.call("rbind", wb$comments[[cmmt]]))
-    if (!is.null(dims)) cmts <- cmts[cmts$ref == dims, ]
-    # print(cmts)
-    cmts <- cmts[c("ref", "author", "comment")]
-    if (nrow(cmts)) {
-      cmts$comment <- as_fmt_txt(cmts$comment)
-      cmts$cmmt_id <- cmmt
-    }
-  }
-  cmts
-}
-
-wb_get_thread <- function(wb, sheet = current_sheet(), dims = "A1") {
-
-  sheet <- wb$validate_sheet(sheet)
-  thrd <- wb$worksheets[[sheet]]$relships$threadedComment
-
-  tc <- cbind(
-    rbindlist(xml_attr(wb$threadComments[[thrd]], "threadedComment")),
-    text = xml_value(wb$threadComments[[thrd]], "threadedComment", "text")
-  )
-
-  if (!is.null(dims)) {
-    tc <- tc[tc$ref == dims, ]
-  }
-
-  persons <- wb$get_person()
-
-  tc <- merge(tc, persons, by.x = "personId", by.y = "id",
-              all.x = TRUE, all.y = FALSE)
-
-  tc$dT <- as.POSIXct(tc$dT, format = "%Y-%m-%dT%H:%M:%SZ")
-
-  tc[c("dT", "ref", "displayName", "text", "done")]
-}

R/class-workbook-wrappers.R

@@ -3375,6 +3375,22 @@ wb_add_comment <- function(
   )
 }
 
+#' @rdname wb_add_comment
+#' @export
+wb_get_comment <- function(
+    wb,
+    sheet = current_sheet(),
+    dims  = NULL
+) {
+
+  assert_workbook(wb)
+
+  wb$clone(deep = TRUE)$get_comment(
+    sheet       = sheet,
+    dims        = dims
+  )
+}
+
 #' @rdname wb_add_comment
 #' @export
 wb_remove_comment <- function(
@@ -3491,6 +3507,22 @@ wb_add_thread <- function(
   )
 }
 
+#' @rdname wb_add_thread
+#' @export
+wb_get_thread <- function(
+    wb,
+    sheet = current_sheet(),
+    dims  = NULL
+) {
+
+  assert_workbook(wb)
+
+  wb$clone(deep = TRUE)$get_thread(
+    sheet       = sheet,
+    dims        = dims
+  )
+}
+
 #' Add a checkbox, radio button or drop menu to a cell in a worksheet
 #'
 #' You can add Form Control to a cell. The three supported types are a Checkbox,

R/class-workbook.R

@@ -4384,6 +4384,36 @@ wbWorkbook <- R6::R6Class(
       invisible(self)
     },
 
+    #' @description Get comments
+    #' @param sheet sheet
+    #' @param dims dims
+    #' @return A data frame containing comments
+    get_comment = function(
+      sheet = current_sheet(),
+      dims  = NULL
+    ) {
+
+      sheet_id <- self$validate_sheet(sheet)
+      cmmt <- self$worksheets[[sheet_id]]$relships$comments
+
+      if (!is.null(dims) && any(grepl(":", dims)))
+        dims <- unname(unlist(dims_to_dataframe(dims, fill = TRUE)))
+
+      cmts <- list()
+      if (length(cmmt) && length(self$comments) <= cmmt) {
+        cmts <- as.data.frame(do.call("rbind", self$comments[[cmmt]]))
+        if (!is.null(dims)) cmts <- cmts[cmts$ref %in% dims, ]
+        # print(cmts)
+        cmts <- cmts[c("ref", "author", "comment")]
+        if (nrow(cmts)) {
+          cmts$comment <- as_fmt_txt(cmts$comment)
+          cmts$cmmt_id <- cmmt
+        }
+      }
+
+      invisible(cmts)
+    },
+
     #' @description Remove comment
     #' @param dims row and column as spreadsheet dimension, e.g. "A1"
     #' @return The `wbWorkbook` object
@@ -4560,6 +4590,37 @@ wbWorkbook <- R6::R6Class(
       invisible(self)
     },
 
+    #' @description Get threads
+    #' @param sheet sheet
+    #' @param dims dims
+    #' @return A data frame containing threads
+    get_thread = function(sheet = current_sheet(), dims = NULL) {
+
+      sheet <- self$validate_sheet(sheet)
+      thrd <- self$worksheets[[sheet]]$relships$threadedComment
+
+      tc <- cbind(
+        rbindlist(xml_attr(self$threadComments[[thrd]], "threadedComment")),
+        text = xml_value(self$threadComments[[thrd]], "threadedComment", "text")
+      )
+
+      if (!is.null(dims) && any(grepl(":", dims)))
+        dims <- unname(unlist(dims_to_dataframe(dims, fill = TRUE)))
+
+      if (!is.null(dims)) {
+        tc <- tc[tc$ref %in% dims, ]
+      }
+
+      persons <- self$get_person()
+
+      tc <- merge(tc, persons, by.x = "personId", by.y = "id",
+                  all.x = TRUE, all.y = FALSE)
+
+      tc$dT <- as.POSIXct(tc$dT, format = "%Y-%m-%dT%H:%M:%SZ")
+
+      tc[c("dT", "ref", "displayName", "text", "done")]
+    },
+
     ## conditional formatting ----
 
     # TODO remove_conditional_formatting?

tests/testthat/test-class-comment.R

@@ -248,12 +248,12 @@ test_that("threaded comments work", {
     text = c("wow it works!", "fascinating"),
     done = c("0", "")
   )
-  got <- wb_get_thread(wb)[, -1]
+  got <- wb_get_thread(wb, dims = "A1")[, -1]
   # somehow the row ordering differs for parallel and non-parallel testthat runs
   expect_equal(exp[order(got$displayName), ], got, ignore_attr = TRUE)
 
   exp <- "[Threaded comment]\n\nYour spreadsheet software allows you to read this threaded comment; however, any edits to it will get removed if the file is opened in a newer version of a certain spreadsheet software.\n\nComment: wow it works!\nReplie:fascinating"
-  got <- wb_get_comment(wb)$comment
+  got <- wb_get_comment(wb, dims = "A1")$comment
   expect_equal(exp, got)
 
   # start a new thread
@@ -266,7 +266,7 @@ test_that("threaded comments work", {
     text = "oops",
     done = "0"
   )
-  got <- wb_get_thread(wb)[, -1]
+  got <- wb_get_thread(wb, dims = "A1")[, -1]
   expect_equal(exp, got)
 
   wb <- wb %>%
@@ -279,7 +279,7 @@ test_that("threaded comments work", {
     text = "hmpf",
     done = "0"
   )
-  got <- wb_get_thread(wb)[, -1]
+  got <- wb_get_thread(wb, dims = "A1")[, -1]
   expect_equal(exp, got)
 
 })