From 35048f165f6f7f3fb47a8bcd4800dea63073fffb Mon Sep 17 00:00:00 2001 From: Jan Marvin Garbuszus Date: Mon, 3 Jul 2023 23:57:31 +0200 Subject: [PATCH 01/10] load person.xml and threadedCommentXML --- R/class-workbook.R | 17 ++++++++--------- R/wb_load.R | 19 ++++++------------- 2 files changed, 14 insertions(+), 22 deletions(-) diff --git a/R/class-workbook.R b/R/class-workbook.R index fdeb8cf1e..40240a238 100644 --- a/R/class-workbook.R +++ b/R/class-workbook.R @@ -1593,12 +1593,9 @@ wbWorkbook <- R6::R6Class( for (i in seq_len(nSheets)) { if (length(self$threadComments[[i]])) { - fl <- self$threadComments[[i]] - file.copy( - from = fl, - to = file.path(xlThreadComments, basename(fl)), - overwrite = TRUE, - copy.date = TRUE + write_file( + body = self$threadComments[[i]], + fl = file.path(xlThreadComments, sprintf("threadedComment%s.xml", i)) ) } } @@ -1607,11 +1604,13 @@ wbWorkbook <- R6::R6Class( ## xl/persons/person.xml if (nPersons) { personDir <- dir_create(tmpDir, "xl", "persons") - file.copy(self$persons, personDir, overwrite = TRUE) + write_file( + body = self$persons, + fl = file.path(personDir, "person.xml") + ) } - - + ## xl/embeddings if (length(self$embeddings)) { embeddingsDir <- dir_create(tmpDir, "xl", "embeddings") for (fl in self$embeddings) { diff --git a/R/wb_load.R b/R/wb_load.R index a81289e0c..85f0c8736 100644 --- a/R/wb_load.R +++ b/R/wb_load.R @@ -136,7 +136,7 @@ wb_load <- function( on.exit( unlink( # TODO: this removes all files, the folders remain. grep instead grep_xml? - grep_xml("media|vmlDrawing|customXml|comment|embeddings|vbaProject|person", ignore.case = TRUE, invert = TRUE), + grep_xml("media|vmlDrawing|customXml|embeddings|vbaProject", ignore.case = TRUE, invert = TRUE), recursive = TRUE, force = TRUE ), add = TRUE @@ -1111,19 +1111,11 @@ wb_load <- function( ## Threaded comments if (length(threadCommentsXML) > 0) { - threadCommentsXMLrelationship <- lapply(xml, function(x) grep("threadedComment[0-9]+\\.xml", x, value = TRUE)) - hasThreadComments <- lengths(threadCommentsXMLrelationship) > 0 - if (any(hasThreadComments)) { - for (i in seq_along(xml)) { - if (hasThreadComments[i]) { - target <- apply_reg_match(threadCommentsXMLrelationship[[i]], '(?<=Target=").*?"') - target <- basename(gsub('"$', "", target)) - wb$threadComments[[i]] <- grep(target, threadCommentsXML, value = TRUE) - - } - } + if (lengths(threadCommentsXML)) { + wb$threadComments <- lapply(threadCommentsXML, read_xml, pointer = FALSE) } + wb$append( "Content_Types", sprintf('', @@ -1133,7 +1125,8 @@ wb_load <- function( ## Persons (needed for Threaded Comment) if (length(personXML) > 0) { - wb$persons <- personXML + wb$persons <- read_xml(personXML, pointer = FALSE) + wb$append( "Content_Types", '' From 77bcf89fd832b50da38b1fcbf4c5f0e221d64b0d Mon Sep 17 00:00:00 2001 From: Jan Marvin Garbuszus Date: Tue, 4 Jul 2023 10:30:08 +0200 Subject: [PATCH 02/10] load --- R/helperFunctions.R | 3 ++- R/wb_load.R | 15 +++++++++++---- tests/testthat/test-loading_workbook.R | 13 ++++++++++++- 3 files changed, 25 insertions(+), 6 deletions(-) diff --git a/R/helperFunctions.R b/R/helperFunctions.R index 733a514f3..840cf349f 100644 --- a/R/helperFunctions.R +++ b/R/helperFunctions.R @@ -198,9 +198,10 @@ write_comment_xml <- function(comment_list, file_name) { comment <- sprintf('%s', comment_list[[i]]$comment[[j]]) } + # either a node or from unstyled comment is_fmt_txt <- FALSE if (is_xml(comment)) - is_fmt_txt <- all(xml_node_name(comment) == "r") + is_fmt_txt <- all(xml_node_name(comment) == "r") || isFALSE(comment_list[[i]]$style[[j]]) if (is_fmt_txt) { xml <- c(xml, comment) diff --git a/R/wb_load.R b/R/wb_load.R index 85f0c8736..67389713d 100644 --- a/R/wb_load.R +++ b/R/wb_load.R @@ -1091,10 +1091,17 @@ wb_load <- function( comments <- lapply(comments, function(x) { text <- xml_node(x, "comment", "text") - list( - style = xml_node(text, "text", "r", "rPr"), - comments = xml_node(text, "text", "r", "t") - ) + if (all(xml_node_name(x, "comment", "text") == "t")) { + list( + style = FALSE, + comments = xml_node(text, "text", "t") + ) + } else { + list( + style = xml_node(text, "text", "r", "rPr"), + comments = xml_node(text, "text", "r", "t") + ) + } }) wb$comments[[comment_xml]] <- lapply(seq_along(comments), function(j) { diff --git a/tests/testthat/test-loading_workbook.R b/tests/testthat/test-loading_workbook.R index f0e1f23b0..8668a9e22 100644 --- a/tests/testthat/test-loading_workbook.R +++ b/tests/testthat/test-loading_workbook.R @@ -36,11 +36,22 @@ test_that("Loading multiple pivot tables: loadPivotTables.xlsx works", { test_that("Load and saving a file with Threaded Comments works", { + tmp <- temp_xlsx() + ## loadThreadComment.xlsx is a simple xlsx file that uses Threaded Comment. fl <- testfile_path("loadThreadComment.xlsx") expect_silent(wb <- wb_load(fl)) + + exp <- "[Threaded comment]\n\nYo" + got <- substr(wb$comments[[1]][[1]]$comment, 1, 25) + expect_equal(exp, got) + # Check that wb can be saved without error - expect_silent(wb_save(wb, path = temp_xlsx())) + expect_silent(wb_save(wb, path = tmp)) + wb <- wb_load(tmp) + + got <- substr(wb$comments[[1]][[1]]$comment, 1, 25) + expect_equal(exp, got) }) From 15f129369778aa96a1ee891663a8c431da29badd Mon Sep 17 00:00:00 2001 From: Jan Marvin Garbuszus Date: Mon, 3 Jul 2023 23:57:31 +0200 Subject: [PATCH 03/10] load person.xml and threadedCommentXML --- R/class-workbook.R | 17 ++++++++--------- R/wb_load.R | 19 ++++++------------- 2 files changed, 14 insertions(+), 22 deletions(-) diff --git a/R/class-workbook.R b/R/class-workbook.R index e12a1ebb6..e887ace49 100644 --- a/R/class-workbook.R +++ b/R/class-workbook.R @@ -1620,12 +1620,9 @@ wbWorkbook <- R6::R6Class( for (i in seq_len(nSheets)) { if (length(self$threadComments[[i]])) { - fl <- self$threadComments[[i]] - file.copy( - from = fl, - to = file.path(xlThreadComments, basename(fl)), - overwrite = TRUE, - copy.date = TRUE + write_file( + body = self$threadComments[[i]], + fl = file.path(xlThreadComments, sprintf("threadedComment%s.xml", i)) ) } } @@ -1634,11 +1631,13 @@ wbWorkbook <- R6::R6Class( ## xl/persons/person.xml if (nPersons) { personDir <- dir_create(tmpDir, "xl", "persons") - file.copy(self$persons, personDir, overwrite = TRUE) + write_file( + body = self$persons, + fl = file.path(personDir, "person.xml") + ) } - - + ## xl/embeddings if (length(self$embeddings)) { embeddingsDir <- dir_create(tmpDir, "xl", "embeddings") for (fl in self$embeddings) { diff --git a/R/wb_load.R b/R/wb_load.R index 0c6c7b634..d2a417425 100644 --- a/R/wb_load.R +++ b/R/wb_load.R @@ -140,7 +140,7 @@ wb_load <- function( on.exit( unlink( # TODO: this removes all files, the folders remain. grep instead grep_xml? - grep_xml("media|vmlDrawing|customXml|comment|embeddings|vbaProject|person", ignore.case = TRUE, invert = TRUE), + grep_xml("media|vmlDrawing|customXml|embeddings|vbaProject", ignore.case = TRUE, invert = TRUE), recursive = TRUE, force = TRUE ), add = TRUE @@ -1115,19 +1115,11 @@ wb_load <- function( ## Threaded comments if (length(threadCommentsXML) > 0) { - threadCommentsXMLrelationship <- lapply(xml, function(x) grep("threadedComment[0-9]+\\.xml", x, value = TRUE)) - hasThreadComments <- lengths(threadCommentsXMLrelationship) > 0 - if (any(hasThreadComments)) { - for (i in seq_along(xml)) { - if (hasThreadComments[i]) { - target <- apply_reg_match(threadCommentsXMLrelationship[[i]], '(?<=Target=").*?"') - target <- basename(gsub('"$', "", target)) - wb$threadComments[[i]] <- grep(target, threadCommentsXML, value = TRUE) - - } - } + if (lengths(threadCommentsXML)) { + wb$threadComments <- lapply(threadCommentsXML, read_xml, pointer = FALSE) } + wb$append( "Content_Types", sprintf('', @@ -1137,7 +1129,8 @@ wb_load <- function( ## Persons (needed for Threaded Comment) if (length(personXML) > 0) { - wb$persons <- personXML + wb$persons <- read_xml(personXML, pointer = FALSE) + wb$append( "Content_Types", '' From e35c8ed69a09784c77f46d48224642f08de93a02 Mon Sep 17 00:00:00 2001 From: Jan Marvin Garbuszus Date: Tue, 4 Jul 2023 10:30:08 +0200 Subject: [PATCH 04/10] load --- R/helperFunctions.R | 3 ++- R/wb_load.R | 15 +++++++++++---- tests/testthat/test-loading_workbook.R | 13 ++++++++++++- 3 files changed, 25 insertions(+), 6 deletions(-) diff --git a/R/helperFunctions.R b/R/helperFunctions.R index dc9d701b8..3dfb88600 100644 --- a/R/helperFunctions.R +++ b/R/helperFunctions.R @@ -198,9 +198,10 @@ write_comment_xml <- function(comment_list, file_name) { comment <- sprintf('%s', comment_list[[i]]$comment[[j]]) } + # either a node or from unstyled comment is_fmt_txt <- FALSE if (is_xml(comment)) - is_fmt_txt <- all(xml_node_name(comment) == "r") + is_fmt_txt <- all(xml_node_name(comment) == "r") || isFALSE(comment_list[[i]]$style[[j]]) if (is_fmt_txt) { xml <- c(xml, comment) diff --git a/R/wb_load.R b/R/wb_load.R index d2a417425..29d9a5309 100644 --- a/R/wb_load.R +++ b/R/wb_load.R @@ -1095,10 +1095,17 @@ wb_load <- function( comments <- lapply(comments, function(x) { text <- xml_node(x, "comment", "text") - list( - style = xml_node(text, "text", "r", "rPr"), - comments = xml_node(text, "text", "r", "t") - ) + if (all(xml_node_name(x, "comment", "text") == "t")) { + list( + style = FALSE, + comments = xml_node(text, "text", "t") + ) + } else { + list( + style = xml_node(text, "text", "r", "rPr"), + comments = xml_node(text, "text", "r", "t") + ) + } }) wb$comments[[comment_xml]] <- lapply(seq_along(comments), function(j) { diff --git a/tests/testthat/test-loading_workbook.R b/tests/testthat/test-loading_workbook.R index f0e1f23b0..8668a9e22 100644 --- a/tests/testthat/test-loading_workbook.R +++ b/tests/testthat/test-loading_workbook.R @@ -36,11 +36,22 @@ test_that("Loading multiple pivot tables: loadPivotTables.xlsx works", { test_that("Load and saving a file with Threaded Comments works", { + tmp <- temp_xlsx() + ## loadThreadComment.xlsx is a simple xlsx file that uses Threaded Comment. fl <- testfile_path("loadThreadComment.xlsx") expect_silent(wb <- wb_load(fl)) + + exp <- "[Threaded comment]\n\nYo" + got <- substr(wb$comments[[1]][[1]]$comment, 1, 25) + expect_equal(exp, got) + # Check that wb can be saved without error - expect_silent(wb_save(wb, path = temp_xlsx())) + expect_silent(wb_save(wb, path = tmp)) + wb <- wb_load(tmp) + + got <- substr(wb$comments[[1]][[1]]$comment, 1, 25) + expect_equal(exp, got) }) From e063dbd0d7ecec154c03fafbec126c680bab8a69 Mon Sep 17 00:00:00 2001 From: Jan Marvin Garbuszus Date: Sun, 16 Jul 2023 16:31:25 +0200 Subject: [PATCH 05/10] development function wb_add_threaded_comment() --- NAMESPACE | 2 + R/class-comment.R | 121 ++++++++++++++++++++++++++++++++++++++++++- R/class-workbook.R | 59 +++++++++++++++++++++ R/helperFunctions.R | 27 ++++++++-- man/wbWorkbook.Rd | 47 +++++++++++++++++ man/wb_add_person.Rd | 23 ++++++++ man/wb_get_person.Rd | 16 ++++++ 7 files changed, 291 insertions(+), 4 deletions(-) create mode 100644 man/wb_add_person.Rd create mode 100644 man/wb_get_person.Rd diff --git a/NAMESPACE b/NAMESPACE index 9429420ee..f477b5186 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -64,6 +64,7 @@ export(wb_add_named_region) export(wb_add_named_style) export(wb_add_numfmt) export(wb_add_page_break) +export(wb_add_person) export(wb_add_pivot_table) export(wb_add_plot) export(wb_add_sparklines) @@ -84,6 +85,7 @@ export(wb_get_cell_style) export(wb_get_creators) export(wb_get_named_regions) export(wb_get_order) +export(wb_get_person) export(wb_get_selected) export(wb_get_sheet_name) export(wb_get_sheet_names) diff --git a/R/class-comment.R b/R/class-comment.R index ef9c5cde3..6952917b3 100644 --- a/R/class-comment.R +++ b/R/class-comment.R @@ -179,7 +179,6 @@ create_comment <- function(text, #' @param comment A Comment object. See [create_comment()]. #' @param dims worksheet cell "A1" #' @rdname comment -#' @keywords internal #' @export write_comment <- function( wb, @@ -388,3 +387,123 @@ remove_comment <- function( wb_comment <- function(text = character(), author = character(), style = character()) { wbComment$new(text = text, author = author, style = style) } + +#' Add person to use for threaded comment +#' +#' If a threaded comment is added, it needs a person attached with it. The default is to create a person with provider id `"None"`. Other providers are possible with specific values for `id` and `user_id`. If you require the following, create a workbook via spreadsheet software load it and get the values with `wb_get_person()` +#' @param wb a workbook +#' @param name the name to display +#' @param id (optional) the display id +#' @param user_id (optional) the user id +#' @param provider_id (optional) the provider id +#' @keywords comments +#' @export +wb_add_person <- function( + wb, + name = NULL, + id = NULL, + user_id = NULL, + provider_id = "None" +) { + assert_workbook(wb) + wb$clone()$add_person( + name = name, + id = id, + user_id = user_id, + provider_id = provider_id + ) +} + +#' Get Person list from workbook +#' +#' Persons are required for threaded comments +#' @param wb a workbook +#' @param name a specific name +#' @export +wb_get_person <- function(wb, name = NULL) { + assert_workbook(wb) + wb$get_person(name) +} + +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) + cmts <- as.data.frame(do.call("rbind", wb$comments[[sheet_id]])) + if (!is.null(dims)) cmts <- cmts[cmts$ref == dims,] + cmts <- cmts[c("ref", "author", "comment")] + cmts$comment <- as_fmt_txt(cmts$comment) + cmts +} + +wb_add_threaded_comment <- function(wb, sheet = current_sheet(), dims = "A1", comment, person_id) { + + assert_workbook(wb) + + sheet <- wb$validate_sheet(sheet) + + if (length(cmt <- wb_get_comment(wb, dims)$comment)) { + # TODO not sure yet what to do + } else { + cmt <- create_comment(text = comment, author = "") + wb$add_comment(sheet = sheet, dims = dims, comment = c1) + } + + if (!length(wb$worksheets[[sheet]]$relships$threadedComment)) { + + # TODO the sheet id is correct ... ? + wb$worksheets[[sheet]]$relships$threadedComment <- sheet + + wb$append( + "Content_Types", + # "", + sprintf("", sheet) + ) + + wb$worksheets_rels[[sheet]] <- append( + wb$worksheets_rels[[sheet]], + c( + sprintf("", length(wb$worksheets_rels[[1]]) + 1L, sheet) + ) + ) + + wb$threadComments <- "" + + } + + + tc <- xml_node_create( + "threadedComment", + xml_attributes = c( + ref = dims, + dT = as_POSIXct_utc(Sys.time()), + personId = person_id, + id = st_guid() + ), + xml_children = xml_node_create("text", xml_children = comment) + ) + + wb$threadComments <- xml_add_child( + wb$threadComments, + xml_child = tc + ) + + + # wb$threadComments <- + # xml_add_child( + # wb$threadComments, + # xml_child = c( + # sprintf("Remember when I added threaded comments? Would be cool if we can have these in {openxlsx2}!", wb_get_person()$id[2], c1_id), + # sprintf("Yes, I do remember! Let's check this out.", wb_get_person()$id[1], c2_id, c1_id), + # sprintf("Yes, I do remember! Let's check this out.", wb_get_person()$id[1], st_guid(), c1_id) + # ) + # ) + + wb +} diff --git a/R/class-workbook.R b/R/class-workbook.R index e887ace49..e6a1ca1f0 100644 --- a/R/class-workbook.R +++ b/R/class-workbook.R @@ -6714,6 +6714,65 @@ wbWorkbook <- R6::R6Class( ... = ... ) invisible(self) + }, + + #' @description add person to workook + #' @param name name + #' @param id id + #' @param user_id user_id + #' @param provider_id provider_id + add_person = function ( + name = NULL, + id = NULL, + user_id = NULL, + provider_id = "None" + ) { + + if (is.null(name)) name <- Sys.getenv("USERNAME", Sys.getenv("USER")) + if (is.null(id)) id <- st_guid() + if (is.null(user_id)) user_id <- st_userid() + + xml_person <- xml_node_create( + "person", + xml_attributes = c( + displayName = name, + id = id, + userId = user_id, + providerId = "None" + ) + ) + + if (is.null(self$persons)) { + self$persons <- xml_node_create( + "personList", + xml_attributes = c( + `xmlns` = "http://schemas.microsoft.com/office/spreadsheetml/2018/threadedcomments", + `xmlns:x` = "http://schemas.openxmlformats.org/spreadsheetml/2006/main" + ) + ) + + self$append( + "workbook.xml.rels", + "" + ) + + wb$append( + "Content_Types", + "" + ) + } + + self$persons <- xml_add_child(self$persons, xml_person) + + invisible(self) + }, + + #' description get person + #' @param name name + get_person = function(name = NULL) { + persons <- rbindlist(xml_attr(self$persons, "personList", "person")) + if (!is.null(name)) persons <- persons[persons$displayName == name, ] + persons } ), diff --git a/R/helperFunctions.R b/R/helperFunctions.R index 3dfb88600..aa49dcd19 100644 --- a/R/helperFunctions.R +++ b/R/helperFunctions.R @@ -112,9 +112,6 @@ create_hyperlink <- function(sheet, row = 1, col = 1, text = NULL, file = NULL) return(str) } - -getRId <- function(x) reg_match0(x, '(?<= r:id=")[0-9A-Za-z]+') - getId <- function(x) reg_match0(x, '(?<= Id=")[0-9A-Za-z]+') # `validateColor()` ------------------------------------------------------------ @@ -225,6 +222,7 @@ pxml <- function(x) { # paste(unique(unlist(x)), collapse = "") paste(unlist(x), collapse = "") } + # `amp_split()` ---------------------------------------------------------------- #' split headerFooter xml into left, center, and right. #' @param x xml string @@ -246,6 +244,7 @@ amp_split <- function(x) { # return the string vector unname(res) } + # Header footer --------------------------------------------------------------- #' get headerFooter from xml into list with left, center, and right. #' @param x xml string @@ -1182,3 +1181,25 @@ to_string <- function(x) { } chr } + +#' create a guid string +#' @keywords internal +#' @noRd +st_guid <- function() { + paste0( + "{", + random_string(length = 8, pattern = "[A-F0-9]"), "-", + random_string(length = 4, pattern = "[A-F0-9]"), "-", + random_string(length = 4, pattern = "[A-F0-9]"), "-", + random_string(length = 4, pattern = "[A-F0-9]"), "-", + random_string(length = 12, pattern = "[A-F0-9]"), + "}" + ) +} + +#' create a userid +#' @keywords internal +#' @noRd +st_userid <- function() { + random_string(length = 16, pattern = "[a-z0-9]") +} diff --git a/man/wbWorkbook.Rd b/man/wbWorkbook.Rd index d18961632..1446388cd 100644 --- a/man/wbWorkbook.Rd +++ b/man/wbWorkbook.Rd @@ -332,6 +332,8 @@ is created, not when the Excel files are saved.} \item \href{#method-wbWorkbook-add_sparklines}{\code{wbWorkbook$add_sparklines()}} \item \href{#method-wbWorkbook-add_ignore_error}{\code{wbWorkbook$add_ignore_error()}} \item \href{#method-wbWorkbook-set_sheetview}{\code{wbWorkbook$set_sheetview()}} +\item \href{#method-wbWorkbook-add_person}{\code{wbWorkbook$add_person()}} +\item \href{#method-wbWorkbook-get_person}{\code{wbWorkbook$get_person()}} \item \href{#method-wbWorkbook-clone}{\code{wbWorkbook$clone()}} } } @@ -3177,6 +3179,51 @@ The \code{wbWorksheetObject}, invisibly } } \if{html}{\out{
}} +\if{html}{\out{}} +\if{latex}{\out{\hypertarget{method-wbWorkbook-add_person}{}}} +\subsection{Method \code{add_person()}}{ +add person to workook +\subsection{Usage}{ +\if{html}{\out{
}}\preformatted{wbWorkbook$add_person( + name = NULL, + id = NULL, + user_id = NULL, + provider_id = "None" +)}\if{html}{\out{
}} +} + +\subsection{Arguments}{ +\if{html}{\out{
}} +\describe{ +\item{\code{name}}{name} + +\item{\code{id}}{id} + +\item{\code{user_id}}{user_id} + +\item{\code{provider_id}}{provider_id +description get person} +} +\if{html}{\out{
}} +} +} +\if{html}{\out{
}} +\if{html}{\out{}} +\if{latex}{\out{\hypertarget{method-wbWorkbook-get_person}{}}} +\subsection{Method \code{get_person()}}{ +\subsection{Usage}{ +\if{html}{\out{
}}\preformatted{wbWorkbook$get_person(name = NULL)}\if{html}{\out{
}} +} + +\subsection{Arguments}{ +\if{html}{\out{
}} +\describe{ +\item{\code{name}}{name} +} +\if{html}{\out{
}} +} +} +\if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-wbWorkbook-clone}{}}} \subsection{Method \code{clone()}}{ diff --git a/man/wb_add_person.Rd b/man/wb_add_person.Rd new file mode 100644 index 000000000..095eea52e --- /dev/null +++ b/man/wb_add_person.Rd @@ -0,0 +1,23 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/class-comment.R +\name{wb_add_person} +\alias{wb_add_person} +\title{Add person to use for threaded comment} +\usage{ +wb_add_person(wb, name = NULL, id = NULL, user_id = NULL, provider_id = "None") +} +\arguments{ +\item{wb}{a workbook} + +\item{name}{the name to display} + +\item{id}{(optional) the display id} + +\item{user_id}{(optional) the user id} + +\item{provider_id}{(optional) the provider id} +} +\description{ +If a threaded comment is added, it needs a person attached with it. The default is to create a person with provider id \code{"None"}. Other providers are possible with specific values for \code{id} and \code{user_id}. If you require the following, create a workbook via spreadsheet software load it and get the values with \code{wb_get_person()} +} +\keyword{comments} diff --git a/man/wb_get_person.Rd b/man/wb_get_person.Rd new file mode 100644 index 000000000..289d1d0c0 --- /dev/null +++ b/man/wb_get_person.Rd @@ -0,0 +1,16 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/class-comment.R +\name{wb_get_person} +\alias{wb_get_person} +\title{Get Person list from workbook} +\usage{ +wb_get_person(wb, name = NULL) +} +\arguments{ +\item{wb}{a workbook} + +\item{name}{a specific name} +} +\description{ +Persons are required for threaded comments +} From 35c162eb2d9b69362aea5fb3683d0b53dc6398d1 Mon Sep 17 00:00:00 2001 From: Jan Marvin Garbuszus Date: Sun, 16 Jul 2023 19:22:52 +0200 Subject: [PATCH 06/10] working example --- NAMESPACE | 1 + R/class-comment.R | 131 +++++++++++++++++++++++++-------- R/class-workbook.R | 4 +- man/wb_add_threaded_comment.Rd | 34 +++++++++ 4 files changed, 138 insertions(+), 32 deletions(-) create mode 100644 man/wb_add_threaded_comment.Rd diff --git a/NAMESPACE b/NAMESPACE index f477b5186..2ee42bf8e 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -69,6 +69,7 @@ export(wb_add_pivot_table) export(wb_add_plot) export(wb_add_sparklines) export(wb_add_style) +export(wb_add_threaded_comment) export(wb_add_worksheet) export(wb_clean_sheet) export(wb_clone_sheet_style) diff --git a/R/class-comment.R b/R/class-comment.R index 6952917b3..97ae6c49d 100644 --- a/R/class-comment.R +++ b/R/class-comment.R @@ -435,24 +435,41 @@ as_fmt_txt <- function(x) { wb_get_comment <- function(wb, sheet = current_sheet(), dims = "A1") { sheet_id <- wb$validate_sheet(sheet) - cmts <- as.data.frame(do.call("rbind", wb$comments[[sheet_id]])) - if (!is.null(dims)) cmts <- cmts[cmts$ref == dims,] - cmts <- cmts[c("ref", "author", "comment")] - cmts$comment <- as_fmt_txt(cmts$comment) + cmts <- list() + if (length(wb$comments)) { + cmts <- as.data.frame(do.call("rbind", wb$comments[[sheet_id]])) + 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$sheet_id <- sheet_id + } + } cmts } -wb_add_threaded_comment <- function(wb, sheet = current_sheet(), dims = "A1", comment, person_id) { +#' add threaded comment to worksheet +#' @param wb a workbook +#' @param sheet a worksheet +#' @param dims a cell +#' @param comment the comment to add +#' @param person_id the person Id this should be added for +#' @param reply logical if the comment is a reply +#' @param resolve logical if the comment should be maked as resolved +#' @export +wb_add_threaded_comment <- function(wb, sheet = current_sheet(), dims = "A1", comment = NULL, person_id, reply = FALSE, resolve = FALSE) { assert_workbook(wb) sheet <- wb$validate_sheet(sheet) + wb_cmt <- wb_get_comment(wb, sheet, dims) - if (length(cmt <- wb_get_comment(wb, dims)$comment)) { + if (length(cmt <- wb_cmt$comment)) { # TODO not sure yet what to do } else { cmt <- create_comment(text = comment, author = "") - wb$add_comment(sheet = sheet, dims = dims, comment = c1) + wb$add_comment(sheet = sheet, dims = dims, comment = cmt) } if (!length(wb$worksheets[[sheet]]$relships$threadedComment)) { @@ -473,37 +490,89 @@ wb_add_threaded_comment <- function(wb, sheet = current_sheet(), dims = "A1", co ) ) - wb$threadComments <- "" + wb$threadComments[[sheet]] <- character() + } + + parentId <- NULL + tcs <- rbindlist(xml_attr(wb$threadComments[[sheet]], "threadedComment")) + sel <- which(tcs$ref == dims) + if (reply && nrow(tcs)) { + if (length(sel)) { + parentId <- tcs[sel[1], ]$id + } else { + warning("cannot reply, will create a new thread") + } } + # update or remove any previous thread from the dims + if (length(sel)) { + if (resolve) { + wb$threadComments[[sheet]][sel[1]] <- xml_attr_mod( + wb$threadComments[[sheet]][sel[1]], + xml_attributes = c(done = as_xml_attr(resolve)) + ) + } else if (!reply) { + wb$threadComments[[sheet]] <- wb$threadComments[[sheet]][-(sel)] + } + } - tc <- xml_node_create( - "threadedComment", - xml_attributes = c( - ref = dims, - dT = as_POSIXct_utc(Sys.time()), - personId = person_id, - id = st_guid() - ), - xml_children = xml_node_create("text", xml_children = comment) - ) + if (!is.null(comment)) { + + # For replies we can update the comment, but the id remains the parentId + cmt_id <- st_guid() + + done <- as_xml_attr(resolve) + if (reply) done <- NULL + + tc <- xml_node_create( + "threadedComment", + xml_attributes = c( + ref = dims, + dT = format(as_POSIXct_utc(Sys.time()), "%Y-%m-%dT%H:%M:%SZ"), + personId = person_id, + id = cmt_id, + parentId = parentId, + done = done + ), + xml_children = xml_node_create("text", xml_children = comment) + ) - wb$threadComments <- xml_add_child( - wb$threadComments, - xml_child = tc - ) + wb$threadComments[[sheet]] <- append( + wb$threadComments[[sheet]], + tc + ) + + if (reply) cmt_id <- parentId + + wb_cmt <- wb_get_comment(wb, sheet, dims) + sId <- wb_cmt$sheet_id + cId <- as.integer(rownames(wb_cmt)) + + tc <- cbind( + rbindlist(xml_attr(wb$threadComments[[sheet]], "threadedComment")), + text = xml_value(wb$threadComments[[sheet]], "threadedComment", "text") + ) + # probably correclty ordered, but we could order these by date? + tc <- tc[which(tc$ref == dims), ] - # wb$threadComments <- - # xml_add_child( - # wb$threadComments, - # xml_child = c( - # sprintf("Remember when I added threaded comments? Would be cool if we can have these in {openxlsx2}!", wb_get_person()$id[2], c1_id), - # sprintf("Yes, I do remember! Let's check this out.", wb_get_person()$id[1], c2_id, c1_id), - # sprintf("Yes, I do remember! Let's check this out.", wb_get_person()$id[1], st_guid(), c1_id) - # ) - # ) + tc <- paste0( + "[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\n", + paste("Comment:", paste0(tc$text, collapse = "\nReplie:")), + "" + ) + + wb$comments[[sId]][[cId]] <- list( + ref = dims, + author = sprintf("tc=%s", cmt_id), + comment = tc, + style = FALSE, + clientData = NULL + ) + + } wb } diff --git a/R/class-workbook.R b/R/class-workbook.R index e6a1ca1f0..6749e5514 100644 --- a/R/class-workbook.R +++ b/R/class-workbook.R @@ -1621,7 +1621,9 @@ wbWorkbook <- R6::R6Class( for (i in seq_len(nSheets)) { if (length(self$threadComments[[i]])) { write_file( - body = self$threadComments[[i]], + head = "", + body = pxml(self$threadComments[[i]]), + tail = "", fl = file.path(xlThreadComments, sprintf("threadedComment%s.xml", i)) ) } diff --git a/man/wb_add_threaded_comment.Rd b/man/wb_add_threaded_comment.Rd new file mode 100644 index 000000000..f92e6817c --- /dev/null +++ b/man/wb_add_threaded_comment.Rd @@ -0,0 +1,34 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/class-comment.R +\name{wb_add_threaded_comment} +\alias{wb_add_threaded_comment} +\title{add threaded comment to worksheet} +\usage{ +wb_add_threaded_comment( + wb, + sheet = current_sheet(), + dims = "A1", + comment = NULL, + person_id, + reply = FALSE, + resolve = FALSE +) +} +\arguments{ +\item{wb}{a workbook} + +\item{sheet}{a worksheet} + +\item{dims}{a cell} + +\item{comment}{the comment to add} + +\item{person_id}{the person Id this should be added for} + +\item{reply}{logical if the comment is a reply} + +\item{resolve}{logical if the comment should be maked as resolved} +} +\description{ +add threaded comment to worksheet +} From c63a3d56ed8d881e5e3deeec5610b000d02e9344 Mon Sep 17 00:00:00 2001 From: Jan Marvin Garbuszus Date: Sun, 16 Jul 2023 20:14:56 +0200 Subject: [PATCH 07/10] add wb_add_threaded_comment() --- R/class-comment.R | 168 +++------------------------- R/class-workbook-wrappers.R | 66 +++++++++++ R/class-workbook.R | 130 +++++++++++++++++++++ tests/testthat/test-class-comment.R | 60 ++++++++++ 4 files changed, 269 insertions(+), 155 deletions(-) diff --git a/R/class-comment.R b/R/class-comment.R index 97ae6c49d..4820884cc 100644 --- a/R/class-comment.R +++ b/R/class-comment.R @@ -388,43 +388,6 @@ wb_comment <- function(text = character(), author = character(), style = charact wbComment$new(text = text, author = author, style = style) } -#' Add person to use for threaded comment -#' -#' If a threaded comment is added, it needs a person attached with it. The default is to create a person with provider id `"None"`. Other providers are possible with specific values for `id` and `user_id`. If you require the following, create a workbook via spreadsheet software load it and get the values with `wb_get_person()` -#' @param wb a workbook -#' @param name the name to display -#' @param id (optional) the display id -#' @param user_id (optional) the user id -#' @param provider_id (optional) the provider id -#' @keywords comments -#' @export -wb_add_person <- function( - wb, - name = NULL, - id = NULL, - user_id = NULL, - provider_id = "None" -) { - assert_workbook(wb) - wb$clone()$add_person( - name = name, - id = id, - user_id = user_id, - provider_id = provider_id - ) -} - -#' Get Person list from workbook -#' -#' Persons are required for threaded comments -#' @param wb a workbook -#' @param name a specific name -#' @export -wb_get_person <- function(wb, name = NULL) { - assert_workbook(wb) - wb$get_person(name) -} - as_fmt_txt <- function(x) { vapply(x, function(y) { ifelse(is_xml(y), si_to_txt(xml_node_create("si", xml_children = y)), y) @@ -436,7 +399,7 @@ as_fmt_txt <- function(x) { wb_get_comment <- function(wb, sheet = current_sheet(), dims = "A1") { sheet_id <- wb$validate_sheet(sheet) cmts <- list() - if (length(wb$comments)) { + if (length(wb$comments) >= sheet_id) { cmts <- as.data.frame(do.call("rbind", wb$comments[[sheet_id]])) if (!is.null(dims)) cmts <- cmts[cmts$ref == dims, ] # print(cmts) @@ -449,130 +412,25 @@ wb_get_comment <- function(wb, sheet = current_sheet(), dims = "A1") { cmts } -#' add threaded comment to worksheet -#' @param wb a workbook -#' @param sheet a worksheet -#' @param dims a cell -#' @param comment the comment to add -#' @param person_id the person Id this should be added for -#' @param reply logical if the comment is a reply -#' @param resolve logical if the comment should be maked as resolved -#' @export -wb_add_threaded_comment <- function(wb, sheet = current_sheet(), dims = "A1", comment = NULL, person_id, reply = FALSE, resolve = FALSE) { - - assert_workbook(wb) +wb_get_threaded_comment <- function(wb, sheet = current_sheet(), dims = "A1") { sheet <- wb$validate_sheet(sheet) - wb_cmt <- wb_get_comment(wb, sheet, dims) - - if (length(cmt <- wb_cmt$comment)) { - # TODO not sure yet what to do - } else { - cmt <- create_comment(text = comment, author = "") - wb$add_comment(sheet = sheet, dims = dims, comment = cmt) - } - - if (!length(wb$worksheets[[sheet]]$relships$threadedComment)) { - - # TODO the sheet id is correct ... ? - wb$worksheets[[sheet]]$relships$threadedComment <- sheet - - wb$append( - "Content_Types", - # "", - sprintf("", sheet) - ) - - wb$worksheets_rels[[sheet]] <- append( - wb$worksheets_rels[[sheet]], - c( - sprintf("", length(wb$worksheets_rels[[1]]) + 1L, sheet) - ) - ) - - wb$threadComments[[sheet]] <- character() - } - - parentId <- NULL - tcs <- rbindlist(xml_attr(wb$threadComments[[sheet]], "threadedComment")) - sel <- which(tcs$ref == dims) - if (reply && nrow(tcs)) { - if (length(sel)) { - parentId <- tcs[sel[1], ]$id - } else { - warning("cannot reply, will create a new thread") - } - } + tc <- cbind( + rbindlist(xml_attr(wb$threadComments[[sheet]], "threadedComment")), + text = xml_value(wb$threadComments[[sheet]], "threadedComment", "text") + ) - # update or remove any previous thread from the dims - if (length(sel)) { - if (resolve) { - wb$threadComments[[sheet]][sel[1]] <- xml_attr_mod( - wb$threadComments[[sheet]][sel[1]], - xml_attributes = c(done = as_xml_attr(resolve)) - ) - } else if (!reply) { - wb$threadComments[[sheet]] <- wb$threadComments[[sheet]][-(sel)] - } + if (!is.null(dims)) { + tc <- tc[tc$ref == dims, ] } - if (!is.null(comment)) { - - # For replies we can update the comment, but the id remains the parentId - cmt_id <- st_guid() - - done <- as_xml_attr(resolve) - if (reply) done <- NULL - - tc <- xml_node_create( - "threadedComment", - xml_attributes = c( - ref = dims, - dT = format(as_POSIXct_utc(Sys.time()), "%Y-%m-%dT%H:%M:%SZ"), - personId = person_id, - id = cmt_id, - parentId = parentId, - done = done - ), - xml_children = xml_node_create("text", xml_children = comment) - ) - - wb$threadComments[[sheet]] <- append( - wb$threadComments[[sheet]], - tc - ) - - if (reply) cmt_id <- parentId - - wb_cmt <- wb_get_comment(wb, sheet, dims) - sId <- wb_cmt$sheet_id - cId <- as.integer(rownames(wb_cmt)) - - tc <- cbind( - rbindlist(xml_attr(wb$threadComments[[sheet]], "threadedComment")), - text = xml_value(wb$threadComments[[sheet]], "threadedComment", "text") - ) - - # probably correclty ordered, but we could order these by date? - tc <- tc[which(tc$ref == dims), ] - - tc <- paste0( - "[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\n", - paste("Comment:", paste0(tc$text, collapse = "\nReplie:")), - "" - ) + persons <- wb$get_person() - wb$comments[[sId]][[cId]] <- list( - ref = dims, - author = sprintf("tc=%s", cmt_id), - comment = tc, - style = FALSE, - clientData = NULL - ) + 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") - wb + tc[c("dT", "ref", "displayName", "text", "done")] } diff --git a/R/class-workbook-wrappers.R b/R/class-workbook-wrappers.R index 07be65212..a164566d3 100644 --- a/R/class-workbook-wrappers.R +++ b/R/class-workbook-wrappers.R @@ -2907,6 +2907,72 @@ wb_remove_comment <- function( ) } +#' Add person to use for threaded comment +#' +#' If a threaded comment is added, it needs a person attached with it. The default is to create a person with provider id `"None"`. Other providers are possible with specific values for `id` and `user_id`. If you require the following, create a workbook via spreadsheet software load it and get the values with `wb_get_person()` +#' @param wb a workbook +#' @param name the name to display +#' @param id (optional) the display id +#' @param user_id (optional) the user id +#' @param provider_id (optional) the provider id +#' @keywords comments +#' @export +wb_add_person <- function( + wb, + name = NULL, + id = NULL, + user_id = NULL, + provider_id = "None" +) { + assert_workbook(wb) + wb$clone()$add_person( + name = name, + id = id, + user_id = user_id, + provider_id = provider_id + ) +} + +#' Get Person list from workbook +#' +#' Persons are required for threaded comments +#' @param wb a workbook +#' @param name a specific name +#' @export +wb_get_person <- function(wb, name = NULL) { + assert_workbook(wb) + wb$get_person(name) +} + +#' add threaded comment to worksheet +#' @param wb a workbook +#' @param sheet a worksheet +#' @param dims a cell +#' @param comment the comment to add +#' @param person_id the person Id this should be added for +#' @param reply logical if the comment is a reply +#' @param resolve logical if the comment should be maked as resolved +#' @export +wb_add_threaded_comment <- function( + wb, + sheet = current_sheet(), + dims = "A1", + comment = NULL, + person_id, + reply = FALSE, + resolve = FALSE +) { + assert_workbook(wb) + wb$clone()$add_threaded_comment( + sheet = sheet, + dims = dims, + comment = comment, + person_id = person_id, + reply = reply, + resolve = resolve + ) +} + #' Add form control Checkbox, Radiobuttons or Dropmenu #' @param wb A workbook object #' @param sheet A worksheet of the workbook diff --git a/R/class-workbook.R b/R/class-workbook.R index 6749e5514..d2fee22c0 100644 --- a/R/class-workbook.R +++ b/R/class-workbook.R @@ -3728,6 +3728,136 @@ wbWorkbook <- R6::R6Class( invisible(self) }, + + #' @description add threaded comment to worksheet + #' @param sheet a worksheet + #' @param dims a cell + #' @param comment the comment to add + #' @param person_id the person Id this should be added for + #' @param reply logical if the comment is a reply + #' @param resolve logical if the comment should be maked as resolved + #' @export + add_threaded_comment = function( + sheet = current_sheet(), + dims = "A1", + comment = NULL, + person_id, + reply = FALSE, + resolve = FALSE + ) { + + sheet <- self$validate_sheet(sheet) + wb_cmt <- wb_get_comment(self, sheet, dims) + + if (length(cmt <- wb_cmt$comment)) { + # TODO not sure yet what to do + } else { + cmt <- create_comment(text = comment, author = "") + self$add_comment(sheet = sheet, dims = dims, comment = cmt) + } + + if (!length(self$worksheets[[sheet]]$relships$threadedComment)) { + + # TODO the sheet id is correct ... ? + self$worksheets[[sheet]]$relships$threadedComment <- sheet + + self$append( + "Content_Types", + sprintf("", sheet) + ) + + self$worksheets_rels[[sheet]] <- append( + self$worksheets_rels[[sheet]], + sprintf("", length(self$worksheets_rels[[sheet]]) + 1L, sheet) + ) + + self$threadComments[[sheet]] <- character() + } + + parentId <- NULL + tcs <- rbindlist(xml_attr(self$threadComments[[sheet]], "threadedComment")) + sel <- which(tcs$ref == dims) + + if (reply && nrow(tcs)) { + if (length(sel)) { + parentId <- tcs[sel[1], ]$id + } else { + warning("cannot reply, will create a new thread") + } + } + + # update or remove any previous thread from the dims + if (length(sel)) { + if (resolve) { + self$threadComments[[sheet]][sel[1]] <- xml_attr_mod( + self$threadComments[[sheet]][sel[1]], + xml_attributes = c(done = as_xml_attr(resolve)) + ) + } else if (!reply) { + self$threadComments[[sheet]] <- self$threadComments[[sheet]][-(sel)] + } + } + + if (!is.null(comment)) { + + # For replies we can update the comment, but the id remains the parentId + cmt_id <- st_guid() + + done <- as_xml_attr(resolve) + if (reply) done <- NULL + + tc <- xml_node_create( + "threadedComment", + xml_attributes = c( + ref = dims, + dT = format(as_POSIXct_utc(Sys.time()), "%Y-%m-%dT%H:%M:%SZ"), + personId = person_id, + id = cmt_id, + parentId = parentId, + done = done + ), + xml_children = xml_node_create("text", xml_children = comment) + ) + + self$threadComments[[sheet]] <- append( + self$threadComments[[sheet]], + tc + ) + + if (reply) cmt_id <- parentId + + wb_cmt <- wb_get_comment(self, sheet, dims) + sId <- wb_cmt$sheet_id + cId <- as.integer(rownames(wb_cmt)) + + tc <- cbind( + rbindlist(xml_attr(self$threadComments[[sheet]], "threadedComment")), + text = xml_value(self$threadComments[[sheet]], "threadedComment", "text") + ) + + # probably correclty ordered, but we could order these by date? + tc <- tc[which(tc$ref == dims), ] + + tc <- paste0( + "[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\n", + paste("Comment:", paste0(tc$text, collapse = "\nReplie:")), + "" + ) + + self$comments[[sId]][[cId]] <- list( + ref = dims, + author = sprintf("tc=%s", cmt_id), + comment = tc, + style = FALSE, + clientData = NULL + ) + + } + + invisible(self) + }, + ## conditional formatting ---- # TODO remove_conditional_formatting? diff --git a/tests/testthat/test-class-comment.R b/tests/testthat/test-class-comment.R index f4b5f297b..b1cb16ef2 100644 --- a/tests/testthat/test-class-comment.R +++ b/tests/testthat/test-class-comment.R @@ -175,3 +175,63 @@ test_that("fmt_txt in comment", { expect_equal(exp, got) }) + +test_that("threaded comments work", { + + wb <- wb_workbook()$add_worksheet() + + wb$add_person(name = "Kirk") + wb$add_person(name = "Uhura") + wb$add_person(name = "Spock") + wb$add_person(name = "Scotty") + + kirk_id <- wb$get_person(name = "Kirk")$id + uhura_id <- wb$get_person(name = "Uhura")$id + spock_id <- wb$get_person(name = "Spock")$id + scotty_id <- wb$get_person(name = "Scotty")$id + + # write a comment to a thread, reply to one and solve some + wb <- wb %>% + wb_add_threaded_comment(dims = "A1", comment = "wow it works!", person_id = kirk_id) %>% + wb_add_threaded_comment(dims = "A2", comment = "indeed", person_id = uhura_id, resolve = TRUE) %>% + wb_add_threaded_comment(dims = "A1", comment = "fascinating", person_id = spock_id, reply = TRUE) + + exp <- data.frame( + ref = c("A1", "A1"), + displayName = c("Kirk", "Spock"), + text = c("wow it works!", "fascinating"), + done = c("0", "") + ) + got <- wb_get_threaded_comment(wb)[,-1] + expect_equal(exp, got) + + 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 + expect_equal(exp, got) + + # start a new thread + wb <- wb %>% + wb_add_threaded_comment(dims = "A1", comment = "oops", person_id = kirk_id) + + exp <- data.frame( + ref = "A1", + displayName = "Kirk", + text = "oops", + done = "0" + ) + got <- wb_get_threaded_comment(wb)[,-1] + expect_equal(exp, got) + + wb <- wb %>% wb_add_worksheet() %>% + wb_add_threaded_comment(dims = "A1", comment = "hmpf", person_id = scotty_id) + + exp <- data.frame( + ref = "A1", + displayName = "Scotty", + text = "hmpf", + done = "0" + ) + got <- wb_get_threaded_comment(wb)[,-1] + expect_equal(exp, got) + +}) From 8ce04f58588e40dd383c1df441cf4a076a646207 Mon Sep 17 00:00:00 2001 From: Jan Marvin Garbuszus Date: Sun, 16 Jul 2023 20:55:03 +0200 Subject: [PATCH 08/10] rename to * wb_add_thread --- .lintr | 1 + NAMESPACE | 2 +- R/class-comment.R | 9 +-- R/class-workbook-wrappers.R | 32 ++++++--- R/class-workbook.R | 6 +- man/comment.Rd | 10 ++- man/wbWorkbook.Rd | 35 ++++++++++ man/wb_add_person.Rd | 23 ------- man/wb_add_thread.Rd | 67 +++++++++++++++++++ man/wb_add_threaded_comment.Rd | 34 ---------- man/wb_get_person.Rd | 16 ----- tests/testthat/test-class-comment.R | 19 +++--- tests/testthat/test-class-workbook-wrappers.R | 31 +++++++++ 13 files changed, 182 insertions(+), 103 deletions(-) delete mode 100644 man/wb_add_person.Rd create mode 100644 man/wb_add_thread.Rd delete mode 100644 man/wb_add_threaded_comment.Rd delete mode 100644 man/wb_get_person.Rd diff --git a/.lintr b/.lintr index 4187aecea..2c94ce6f7 100644 --- a/.lintr +++ b/.lintr @@ -8,6 +8,7 @@ linters: linters_with_defaults( exclusions: list( # otherwise they will throw locally "vignettes/conditional-formatting.R", + "vignettes/openxlsx2.R", "vignettes/openxlsx2_basic_manual.R", "vignettes/openxlsx2_charts_manual.R", "vignettes/openxlsx2_formulas_manual.R", diff --git a/NAMESPACE b/NAMESPACE index 2ee42bf8e..e6e661fa4 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -69,7 +69,7 @@ export(wb_add_pivot_table) export(wb_add_plot) export(wb_add_sparklines) export(wb_add_style) -export(wb_add_threaded_comment) +export(wb_add_thread) export(wb_add_worksheet) export(wb_clean_sheet) export(wb_clone_sheet_style) diff --git a/R/class-comment.R b/R/class-comment.R index 4820884cc..0292b0c41 100644 --- a/R/class-comment.R +++ b/R/class-comment.R @@ -87,9 +87,10 @@ wbComment <- R6::R6Class( #' @name create_comment #' @title Create, write and remove comments #' @description The comment functions (create, write and remove) allow the -#' modification of comments. In newer Excels they are called notes, while they -#' are called comments in openxml. Modification of what Excel now calls comment -#' (openxml calls them threadedComments) is not yet possible +#' modification of comments. In newer spreadsheet software they are called +#' notes, while they are called comments in openxml. Modification of what +#' newer spreadsheet software now calls comment is possible via +#' [wb_add_thread()]. #' @param text Comment text. Character vector. #' @param author Author of comment. Character vector of length 1 #' @param style A Style object or list of style objects the same length as comment vector. @@ -412,7 +413,7 @@ wb_get_comment <- function(wb, sheet = current_sheet(), dims = "A1") { cmts } -wb_get_threaded_comment <- function(wb, sheet = current_sheet(), dims = "A1") { +wb_get_thread <- function(wb, sheet = current_sheet(), dims = "A1") { sheet <- wb$validate_sheet(sheet) diff --git a/R/class-workbook-wrappers.R b/R/class-workbook-wrappers.R index a164566d3..794e6afa3 100644 --- a/R/class-workbook-wrappers.R +++ b/R/class-workbook-wrappers.R @@ -2863,6 +2863,7 @@ wb_add_dxfs_style <- function( #' @param ... additional arguments #' @returns The `wbWorkbook` object #' @rdname comment +#' @seealso [wb_add_thread()] #' @export wb_add_comment <- function( wb, @@ -2907,9 +2908,9 @@ wb_remove_comment <- function( ) } -#' Add person to use for threaded comment -#' -#' If a threaded comment is added, it needs a person attached with it. The default is to create a person with provider id `"None"`. Other providers are possible with specific values for `id` and `user_id`. If you require the following, create a workbook via spreadsheet software load it and get the values with `wb_get_person()` +#' @rdname wb_add_thread +#' @details +#' If a threaded comment is added, it needs a person attached with it. The default is to create a person with provider id `"None"`. Other providers are possible with specific values for `id` and `user_id`. If you require the following, create a workbook via spreadsheet software load it and get the values with [wb_get_person()] #' @param wb a workbook #' @param name the name to display #' @param id (optional) the display id @@ -2933,11 +2934,7 @@ wb_add_person <- function( ) } -#' Get Person list from workbook -#' -#' Persons are required for threaded comments -#' @param wb a workbook -#' @param name a specific name +#' @rdname wb_add_thread #' @export wb_get_person <- function(wb, name = NULL) { assert_workbook(wb) @@ -2945,6 +2942,8 @@ wb_get_person <- function(wb, name = NULL) { } #' add threaded comment to worksheet +#' +#' These functions allow adding thread comments to spreadsheets. This is not yet supported by all spreadsheet software. #' @param wb a workbook #' @param sheet a worksheet #' @param dims a cell @@ -2952,8 +2951,21 @@ wb_get_person <- function(wb, name = NULL) { #' @param person_id the person Id this should be added for #' @param reply logical if the comment is a reply #' @param resolve logical if the comment should be maked as resolved +#' @seealso [wb_add_comment()] +#' @name wb_add_thread +#' @examples +#' wb <- wb_workbook()$add_worksheet()$ +#' add_person(name = "openxlsx2") +#' +#' pid <- wb$get_person(name = "openxlsx")$id +#' +#' # write a comment to a thread, reply to one and solve some +#' wb <- wb %>% +#' wb_add_thread(dims = "A1", comment = "wow it works!", person_id = pid) %>% +#' wb_add_thread(dims = "A2", comment = "indeed", person_id = pid, resolve = TRUE) %>% +#' wb_add_thread(dims = "A1", comment = "so cool", person_id = pid, reply = TRUE) #' @export -wb_add_threaded_comment <- function( +wb_add_thread <- function( wb, sheet = current_sheet(), dims = "A1", @@ -2963,7 +2975,7 @@ wb_add_threaded_comment <- function( resolve = FALSE ) { assert_workbook(wb) - wb$clone()$add_threaded_comment( + wb$clone()$add_thread( sheet = sheet, dims = dims, comment = comment, diff --git a/R/class-workbook.R b/R/class-workbook.R index d2fee22c0..457964ee4 100644 --- a/R/class-workbook.R +++ b/R/class-workbook.R @@ -3737,7 +3737,7 @@ wbWorkbook <- R6::R6Class( #' @param reply logical if the comment is a reply #' @param resolve logical if the comment should be maked as resolved #' @export - add_threaded_comment = function( + add_thread = function( sheet = current_sheet(), dims = "A1", comment = NULL, @@ -6853,7 +6853,7 @@ wbWorkbook <- R6::R6Class( #' @param id id #' @param user_id user_id #' @param provider_id provider_id - add_person = function ( + add_person = function( name = NULL, id = NULL, user_id = NULL, @@ -6888,7 +6888,7 @@ wbWorkbook <- R6::R6Class( "" ) - wb$append( + self$append( "Content_Types", "" ) diff --git a/man/comment.Rd b/man/comment.Rd index 29a9de510..0370b473a 100644 --- a/man/comment.Rd +++ b/man/comment.Rd @@ -76,9 +76,10 @@ The \code{wbWorkbook} object } \description{ The comment functions (create, write and remove) allow the -modification of comments. In newer Excels they are called notes, while they -are called comments in openxml. Modification of what Excel now calls comment -(openxml calls them threadedComments) is not yet possible +modification of comments. In newer spreadsheet software they are called +notes, while they are called comments in openxml. Modification of what +newer spreadsheet software now calls comment is possible via +\code{\link[=wb_add_thread]{wb_add_thread()}}. } \examples{ wb <- wb_workbook() @@ -102,4 +103,7 @@ write_comment(wb, 1, col = 6, row = 3, comment = c3) # remove the first comment remove_comment(wb, 1, col = "B", row = 10) } +\seealso{ +\code{\link[=wb_add_thread]{wb_add_thread()}} +} \keyword{internal} diff --git a/man/wbWorkbook.Rd b/man/wbWorkbook.Rd index 1446388cd..ac18bdff3 100644 --- a/man/wbWorkbook.Rd +++ b/man/wbWorkbook.Rd @@ -291,6 +291,7 @@ is created, not when the Excel files are saved.} \item \href{#method-wbWorkbook-freeze_pane}{\code{wbWorkbook$freeze_pane()}} \item \href{#method-wbWorkbook-add_comment}{\code{wbWorkbook$add_comment()}} \item \href{#method-wbWorkbook-remove_comment}{\code{wbWorkbook$remove_comment()}} +\item \href{#method-wbWorkbook-add_thread}{\code{wbWorkbook$add_thread()}} \item \href{#method-wbWorkbook-add_conditional_formatting}{\code{wbWorkbook$add_conditional_formatting()}} \item \href{#method-wbWorkbook-add_image}{\code{wbWorkbook$add_image()}} \item \href{#method-wbWorkbook-add_plot}{\code{wbWorkbook$add_plot()}} @@ -1670,6 +1671,40 @@ Remove comment } } \if{html}{\out{
}} +\if{html}{\out{}} +\if{latex}{\out{\hypertarget{method-wbWorkbook-add_thread}{}}} +\subsection{Method \code{add_thread()}}{ +add threaded comment to worksheet +\subsection{Usage}{ +\if{html}{\out{
}}\preformatted{wbWorkbook$add_thread( + sheet = current_sheet(), + dims = "A1", + comment = NULL, + person_id, + reply = FALSE, + resolve = FALSE +)}\if{html}{\out{
}} +} + +\subsection{Arguments}{ +\if{html}{\out{
}} +\describe{ +\item{\code{sheet}}{a worksheet} + +\item{\code{dims}}{a cell} + +\item{\code{comment}}{the comment to add} + +\item{\code{person_id}}{the person Id this should be added for} + +\item{\code{reply}}{logical if the comment is a reply} + +\item{\code{resolve}}{logical if the comment should be maked as resolved} +} +\if{html}{\out{
}} +} +} +\if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-wbWorkbook-add_conditional_formatting}{}}} \subsection{Method \code{add_conditional_formatting()}}{ diff --git a/man/wb_add_person.Rd b/man/wb_add_person.Rd deleted file mode 100644 index 095eea52e..000000000 --- a/man/wb_add_person.Rd +++ /dev/null @@ -1,23 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/class-comment.R -\name{wb_add_person} -\alias{wb_add_person} -\title{Add person to use for threaded comment} -\usage{ -wb_add_person(wb, name = NULL, id = NULL, user_id = NULL, provider_id = "None") -} -\arguments{ -\item{wb}{a workbook} - -\item{name}{the name to display} - -\item{id}{(optional) the display id} - -\item{user_id}{(optional) the user id} - -\item{provider_id}{(optional) the provider id} -} -\description{ -If a threaded comment is added, it needs a person attached with it. The default is to create a person with provider id \code{"None"}. Other providers are possible with specific values for \code{id} and \code{user_id}. If you require the following, create a workbook via spreadsheet software load it and get the values with \code{wb_get_person()} -} -\keyword{comments} diff --git a/man/wb_add_thread.Rd b/man/wb_add_thread.Rd new file mode 100644 index 000000000..5b4d1d71e --- /dev/null +++ b/man/wb_add_thread.Rd @@ -0,0 +1,67 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/class-workbook-wrappers.R +\name{wb_add_person} +\alias{wb_add_person} +\alias{wb_get_person} +\alias{wb_add_thread} +\title{add threaded comment to worksheet} +\usage{ +wb_add_person(wb, name = NULL, id = NULL, user_id = NULL, provider_id = "None") + +wb_get_person(wb, name = NULL) + +wb_add_thread( + wb, + sheet = current_sheet(), + dims = "A1", + comment = NULL, + person_id, + reply = FALSE, + resolve = FALSE +) +} +\arguments{ +\item{wb}{a workbook} + +\item{name}{the name to display} + +\item{id}{(optional) the display id} + +\item{user_id}{(optional) the user id} + +\item{provider_id}{(optional) the provider id} + +\item{sheet}{a worksheet} + +\item{dims}{a cell} + +\item{comment}{the comment to add} + +\item{person_id}{the person Id this should be added for} + +\item{reply}{logical if the comment is a reply} + +\item{resolve}{logical if the comment should be maked as resolved} +} +\description{ +These functions allow adding thread comments to spreadsheets. This is not yet supported by all spreadsheet software. +} +\details{ +If a threaded comment is added, it needs a person attached with it. The default is to create a person with provider id \code{"None"}. Other providers are possible with specific values for \code{id} and \code{user_id}. If you require the following, create a workbook via spreadsheet software load it and get the values with \code{wb_get_person()} +} +\examples{ +wb <- wb_workbook()$add_worksheet()$ +add_person(name = "openxlsx2") + +pid <- wb$get_person(name = "openxlsx")$id + +# write a comment to a thread, reply to one and solve some +wb <- wb \%>\% + wb_add_thread(dims = "A1", comment = "wow it works!", person_id = pid) \%>\% + wb_add_thread(dims = "A2", comment = "indeed", person_id = pid, resolve = TRUE) \%>\% + wb_add_thread(dims = "A1", comment = "so cool", person_id = pid, reply = TRUE) +} +\seealso{ +\code{\link[=wb_add_comment]{wb_add_comment()}} +} +\keyword{comments} diff --git a/man/wb_add_threaded_comment.Rd b/man/wb_add_threaded_comment.Rd deleted file mode 100644 index f92e6817c..000000000 --- a/man/wb_add_threaded_comment.Rd +++ /dev/null @@ -1,34 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/class-comment.R -\name{wb_add_threaded_comment} -\alias{wb_add_threaded_comment} -\title{add threaded comment to worksheet} -\usage{ -wb_add_threaded_comment( - wb, - sheet = current_sheet(), - dims = "A1", - comment = NULL, - person_id, - reply = FALSE, - resolve = FALSE -) -} -\arguments{ -\item{wb}{a workbook} - -\item{sheet}{a worksheet} - -\item{dims}{a cell} - -\item{comment}{the comment to add} - -\item{person_id}{the person Id this should be added for} - -\item{reply}{logical if the comment is a reply} - -\item{resolve}{logical if the comment should be maked as resolved} -} -\description{ -add threaded comment to worksheet -} diff --git a/man/wb_get_person.Rd b/man/wb_get_person.Rd deleted file mode 100644 index 289d1d0c0..000000000 --- a/man/wb_get_person.Rd +++ /dev/null @@ -1,16 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/class-comment.R -\name{wb_get_person} -\alias{wb_get_person} -\title{Get Person list from workbook} -\usage{ -wb_get_person(wb, name = NULL) -} -\arguments{ -\item{wb}{a workbook} - -\item{name}{a specific name} -} -\description{ -Persons are required for threaded comments -} diff --git a/tests/testthat/test-class-comment.R b/tests/testthat/test-class-comment.R index b1cb16ef2..06fcc9ea1 100644 --- a/tests/testthat/test-class-comment.R +++ b/tests/testthat/test-class-comment.R @@ -192,9 +192,9 @@ test_that("threaded comments work", { # write a comment to a thread, reply to one and solve some wb <- wb %>% - wb_add_threaded_comment(dims = "A1", comment = "wow it works!", person_id = kirk_id) %>% - wb_add_threaded_comment(dims = "A2", comment = "indeed", person_id = uhura_id, resolve = TRUE) %>% - wb_add_threaded_comment(dims = "A1", comment = "fascinating", person_id = spock_id, reply = TRUE) + wb_add_thread(dims = "A1", comment = "wow it works!", person_id = kirk_id) %>% + wb_add_thread(dims = "A2", comment = "indeed", person_id = uhura_id, resolve = TRUE) %>% + wb_add_thread(dims = "A1", comment = "fascinating", person_id = spock_id, reply = TRUE) exp <- data.frame( ref = c("A1", "A1"), @@ -202,7 +202,7 @@ test_that("threaded comments work", { text = c("wow it works!", "fascinating"), done = c("0", "") ) - got <- wb_get_threaded_comment(wb)[,-1] + got <- wb_get_thread(wb)[, -1] expect_equal(exp, got) 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" @@ -211,7 +211,7 @@ test_that("threaded comments work", { # start a new thread wb <- wb %>% - wb_add_threaded_comment(dims = "A1", comment = "oops", person_id = kirk_id) + wb_add_thread(dims = "A1", comment = "oops", person_id = kirk_id) exp <- data.frame( ref = "A1", @@ -219,11 +219,12 @@ test_that("threaded comments work", { text = "oops", done = "0" ) - got <- wb_get_threaded_comment(wb)[,-1] + got <- wb_get_thread(wb)[, -1] expect_equal(exp, got) - wb <- wb %>% wb_add_worksheet() %>% - wb_add_threaded_comment(dims = "A1", comment = "hmpf", person_id = scotty_id) + wb <- wb %>% + wb_add_worksheet() %>% + wb_add_thread(dims = "A1", comment = "hmpf", person_id = scotty_id) exp <- data.frame( ref = "A1", @@ -231,7 +232,7 @@ test_that("threaded comments work", { text = "hmpf", done = "0" ) - got <- wb_get_threaded_comment(wb)[,-1] + got <- wb_get_thread(wb)[, -1] expect_equal(exp, got) }) diff --git a/tests/testthat/test-class-workbook-wrappers.R b/tests/testthat/test-class-workbook-wrappers.R index d067c5794..864faba2f 100644 --- a/tests/testthat/test-class-workbook-wrappers.R +++ b/tests/testthat/test-class-workbook-wrappers.R @@ -389,6 +389,37 @@ test_that("wb_remove_comment() is a wrapper", { }) +# wb_add_thread() --------------------------------------------------------- + +test_that("wb_add_thread() is a wrapper", { + + wb <- wb_workbook()$add_worksheet() + + expect_wrapper( + "add_person", + wb = wb, + params = list(name = "me") + ) + + wb <- wb_workbook()$add_worksheet()$add_person("me") + + expect_wrapper( + "get_person", + wb = wb, + params = list(name = "me") + ) + + wb <- wb_workbook()$add_worksheet()$add_person("me") + me_id <- wb$get_person("me")$id + + expect_wrapper( + "add_thread", + wb = wb, + params = list(comment = "test", person_id = me_id) + ) + +}) + # wb_add_form_control() --------------------------------------------------- test_that("wb_add_form_control() is a wrapper", { From 1202ca4d33aa210983226d73131563ce29eb88d5 Mon Sep 17 00:00:00 2001 From: Jan Marvin Garbuszus Date: Sun, 16 Jul 2023 21:03:42 +0200 Subject: [PATCH 09/10] provide an option for the id --- R/class-workbook-wrappers.R | 5 +++++ R/class-workbook.R | 7 +++++++ man/wb_add_thread.Rd | 2 +- tests/testthat/test-class-comment.R | 12 ++++++++++++ 4 files changed, 25 insertions(+), 1 deletion(-) diff --git a/R/class-workbook-wrappers.R b/R/class-workbook-wrappers.R index 794e6afa3..9b83bdd57 100644 --- a/R/class-workbook-wrappers.R +++ b/R/class-workbook-wrappers.R @@ -2974,6 +2974,11 @@ wb_add_thread <- function( reply = FALSE, resolve = FALSE ) { + + if (missing(person_id)) { + person_id <- substitute() + } + assert_workbook(wb) wb$clone()$add_thread( sheet = sheet, diff --git a/R/class-workbook.R b/R/class-workbook.R index 457964ee4..494a54f0f 100644 --- a/R/class-workbook.R +++ b/R/class-workbook.R @@ -3746,6 +3746,11 @@ wbWorkbook <- R6::R6Class( resolve = FALSE ) { + if (missing(person_id)) { + person_id <- getOption("openxlsx2.thread_id") + if (is.null(person_id)) stop("no person id found") + } + sheet <- self$validate_sheet(sheet) wb_cmt <- wb_get_comment(self, sheet, dims) @@ -6874,6 +6879,8 @@ wbWorkbook <- R6::R6Class( ) ) + options("openxlsx2.thread_id" = id) + if (is.null(self$persons)) { self$persons <- xml_node_create( "personList", diff --git a/man/wb_add_thread.Rd b/man/wb_add_thread.Rd index 5b4d1d71e..d27d5b71d 100644 --- a/man/wb_add_thread.Rd +++ b/man/wb_add_thread.Rd @@ -47,7 +47,7 @@ wb_add_thread( These functions allow adding thread comments to spreadsheets. This is not yet supported by all spreadsheet software. } \details{ -If a threaded comment is added, it needs a person attached with it. The default is to create a person with provider id \code{"None"}. Other providers are possible with specific values for \code{id} and \code{user_id}. If you require the following, create a workbook via spreadsheet software load it and get the values with \code{wb_get_person()} +If a threaded comment is added, it needs a person attached with it. The default is to create a person with provider id \code{"None"}. Other providers are possible with specific values for \code{id} and \code{user_id}. If you require the following, create a workbook via spreadsheet software load it and get the values with \code{\link[=wb_get_person]{wb_get_person()}} } \examples{ wb <- wb_workbook()$add_worksheet()$ diff --git a/tests/testthat/test-class-comment.R b/tests/testthat/test-class-comment.R index 06fcc9ea1..b1675381f 100644 --- a/tests/testthat/test-class-comment.R +++ b/tests/testthat/test-class-comment.R @@ -236,3 +236,15 @@ test_that("threaded comments work", { expect_equal(exp, got) }) + +test_that("thread option works", { + + wb <- wb_workbook()$add_worksheet() + wb$add_person(name = "Kirk") + wb <- wb %>% wb_add_thread(comment = "works") + + exp <- "works" + got <- wb_get_thread(wb)$text + expect_equal(exp, got) + +}) From ee11b2b2b003fef74e318cb062ce5099b091d6d0 Mon Sep 17 00:00:00 2001 From: Jan Marvin Garbuszus Date: Sun, 16 Jul 2023 21:05:45 +0200 Subject: [PATCH 10/10] update NEWS --- NEWS.md | 1 + 1 file changed, 1 insertion(+) diff --git a/NEWS.md b/NEWS.md index 45877de0a..57a38e142 100644 --- a/NEWS.md +++ b/NEWS.md @@ -29,6 +29,7 @@ * `wb_dims(1:5, letters)` * `wb_dims(1:5, 1:26)` * `wb_dims(matrix(1, 5, 26))` with an added row for column names +* Handling of thread comments is not possible via `wb_add_thread()`. This includes options to reply and resolve comments. ## Refactoring