From e063dbd0d7ecec154c03fafbec126c680bab8a69 Mon Sep 17 00:00:00 2001 From: Jan Marvin Garbuszus Date: Sun, 16 Jul 2023 16:31:25 +0200 Subject: [PATCH] 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 +}