testsetup()
test_that("class wbComment works", {
expect_null(assert_comment(wb_comment()))
})
test_that("wb_comment and create_comment are the same except for the different defaults", {
c1 <- create_comment("x1", author = "")
c1_wb <- wb_comment("x1", visible = TRUE, author = "")
expect_equal(c1, c1_wb)
# create_comment drops multiple widths and heights silently.
# wb_comment errors in this case
expect_silent(create_comment(text = "x", author = "", width = c(1, 2)))
expect_error(wb_comment(text = "x", author = "", width = c(1, 2)), "width must be a single")
})
test_that("create_comment() works", {
# error checking
expect_silent(create_comment("hi", width = 1))
expect_silent(create_comment("hi", width = 1L))
expect_silent(create_comment("hi", width = c(1, 2)))
expect_silent(create_comment("hi", width = 1:2))
expect_error(wb_comment("hi", width = 1:2), regexp = "width must be a")
expect_silent(create_comment("hi", height = 1))
expect_silent(create_comment("hi", height = 1L))
expect_silent(create_comment("hi", height = 1:2))
expect_error(wb_comment("hi", height = 1:2))
expect_error(create_comment("hi", visible = NULL))
expect_error(create_comment("hi", visible = c(TRUE, FALSE)))
expect_error(create_comment("hi", author = 1))
expect_error(create_comment("hi", author = c("a", "a")))
expect_s3_class(create_comment("Hello"), "wbComment")
})
test_that("comments", {
tmp <- temp_xlsx()
wb <- wb_workbook()
wb$add_worksheet("Sheet 1")
# write comment without author
c1 <- create_comment(text = "this is a comment", author = "")
wb <- wb_add_comment(wb, 1, dims = "B10", comment = c1)
# Write another comment with author information
c2 <- create_comment(text = "this is another comment", author = "Marco Polo")
wb <- wb_add_comment(wb, 1, dims = "C10", comment = c2)
# write a styled comment with system author
s1 <- create_font(b = "true", color = wb_colour(hex = "FFFF0000"), sz = "12")
s2 <- create_font(color = wb_colour(hex = "FF000000"), sz = "9")
c3 <- create_comment(text = c("This Part Bold red\n\n", "This part black"), style = c(s1, s2))
expect_silent(wb$add_comment(1, dims = "F1", comment = c3))
expect_length(wb$comments, 1)
expect_length(wb$comments[[1]], 3)
expect_silent(wb$remove_comment(1, dims = "B10"))
expect_length(wb$comments, 1)
expect_length(wb$comments[[1]], 2)
expect_silent(wb_save(wb, tmp))
# write on second sheet
tmp <- temp_xlsx()
wb <- wb_workbook()
wb$add_worksheet()
wb$add_worksheet()
# write comment without author
c1 <- create_comment(text = "this is a comment", author = "", visible = FALSE)
wb$add_comment(dims = "B10", comment = c1)
expect_silent(wb$save(tmp))
})
test_that("load comments", {
fl <- testfile_path("pivot_notes.xlsx")
wb <- wb_load(fl)
temp <- temp_xlsx()
wb$save(temp)
tempd <- temp_dir("comment_ext")
unzip(temp, exdir = tempd)
comments <- dir(path = paste0(tempd, "/xl"), pattern = "comment")
expect_equal(c("comments1.xml", "comments2.xml"), comments)
unlink(tempd, recursive = TRUE)
## add a new comment to a workbook that has comments
c1 <- create_comment(text = "this is a comment", author = "")
expect_silent(wb$add_comment(5, dims = "B10", comment = c1))
wb$save(temp)
tempd <- temp_dir("comment_ext")
unzip(temp, exdir = tempd)
comments <- dir(path = paste0(tempd, "/xl"), pattern = "comment")
expect_equal(c("comments1.xml", "comments2.xml", "comments3.xml"), comments)
unlink(tempd, recursive = TRUE)
})
test_that("wb_add_comment", {
c1 <- create_comment(text = "this is a comment", author = "")
wb <- wb_workbook()$add_worksheet()$add_comment(dims = "A1", comment = c1)
wb2 <- wb_workbook() %>%
wb_add_worksheet() %>%
wb_add_comment(dims = "A1", comment = c1)
expect_equal(wb$comments, wb2$comments)
expect_error(
wb_workbook()$add_worksheet()$add_comment(dims = "A1"),
'argument "comment" is missing, with no default'
)
})
test_that("wb_add_comment() works without supplying a wbComment object.", {
# Do not alter the workspace
op <- options("openxlsx2.creator" = "user")
on.exit(options(op), add = TRUE)
# Using the new default values of wb_comment() (options("openxlsx2.creators))
wb <- wb_workbook()$add_worksheet()$add_comment(comment = "this is a comment", dims = "A1")
c2 <- wb_comment(text = "this is a comment")
wb2 <- wb_workbook() %>%
wb_add_worksheet() %>%
wb_add_comment(dims = "A1", comment = c2)
# wb_comment() defaults and comment = "text" defaults are the same.
expect_equal(wb$comments, wb2$comments)
# The wrapper behaves the same
wb3 <- wb_workbook()$add_worksheet()$add_comment(comment = "this is a comment")
expect_equal(wb$comments, wb3$comments)
})
test_that("wb_remove_comment", {
c1 <- create_comment(text = "this is a comment", author = "")
wb <- wb_workbook()$
add_worksheet()$
add_comment(dims = "A1", comment = c1)$
remove_comment(dims = "A1")
# deprecated col / row code
wb2 <- wb_workbook() %>% wb_add_worksheet()
expect_warning(
wb2 <- wb2 %>%
wb_add_comment(col = "A", row = 1, comment = c1),
"'col/row' is deprecated."
)
expect_warning(
wb2 <- wb2 %>% wb_remove_comment(col = "A", row = 1),
"'col/row/gridExpand' is deprecated."
)
expect_equal(wb$comments, wb2$comments)
})
test_that("print comment", {
c2 <- create_comment(text = "this is another comment",
author = "Marco Polo")
got <- capture_output(print(c2), print = TRUE)
exp <- "Author: Marco Polo\nText:\n Marco Polo:\nthis is another comment\n\nStyle:\n\n\n\n\nFont name: Aptos Narrow\nFont size: 11\nFont color: #000000\n\n"
expect_equal(got, exp)
})
test_that("removing comment sheet works", {
temp <- temp_xlsx()
c1 <- create_comment(text = "this is a comment", author = "")
wb <- wb_workbook()$
add_worksheet("Sheet 1")$
add_comment(dims = "B10", comment = c1)$
add_worksheet()$
remove_worksheet(1)
expect_silent(wb$save(temp))
})
test_that("fmt_txt in comment", {
tmp <- temp_xlsx()
txt <- fmt_txt("Hello ", bold = TRUE) + fmt_txt("World")
c1 <- create_comment(text = txt, author = "bla")
wb <- wb_workbook()$add_worksheet()$add_comment(dims = "B10", comment = c1)
expect_silent(wb$save(tmp))
wb <- wb$load(tmp)
exp <- c(
"bla:", "\n",
"Hello ", "World"
)
got <- wb$comments[[1]][[1]]$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_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"),
displayName = c("Kirk", "Spock"),
text = c("wow it works!", "fascinating"),
done = c("0", "")
)
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, dims = "A1")$comment
expect_equal(exp, got)
# start a new thread
wb <- wb %>%
wb_add_thread(dims = "A1", comment = "oops", person_id = kirk_id)
exp <- data.frame(
ref = "A1",
displayName = "Kirk",
text = "oops",
done = "0"
)
got <- wb_get_thread(wb, dims = "A1")[, -1]
expect_equal(exp, got)
wb <- wb %>%
wb_add_worksheet() %>%
wb_add_thread(dims = "A1", comment = "hmpf", person_id = scotty_id)
exp <- data.frame(
ref = "A1",
displayName = "Scotty",
text = "hmpf",
done = "0"
)
got <- wb_get_thread(wb, dims = "A1")[, -1]
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)
})
test_that("background images work", {
wb <- wb_workbook()
wb$add_worksheet("Sheet 1")
# file extension must be png or jpeg, not jpg?
tmp <- tempfile(fileext = ".png")
png(filename = tmp, bg = "transparent")
plot(1:10)
rect(1, 5, 3, 7, col = "white")
dev.off()
# write comment without author
c1 <- wb_comment(text = "this is a comment", author = "", visible = TRUE)
wb$add_comment(dims = "B12", comment = c1, file = tmp)
img <- system.file("extdata", "einstein.jpg", package = "openxlsx2")
wb$add_worksheet()$add_image(dims = "C5", file = img, width = 6, height = 5)
wb$add_comment(dims = "B12", comment = c1)
wb$add_worksheet()
# file extension must be png or jpeg, not jpg?
tmp2 <- tempfile(fileext = ".png")
png(filename = tmp2, bg = "transparent")
barplot(1:10)
dev.off()
# write comment without author
c1 <- wb_comment(text = "this is a comment", author = "", visible = TRUE)
wb$add_comment(dims = "G12", comment = c1, file = tmp2)
wb$add_comment(dims = "G12", sheet = 1, comment = c1, file = tmp2)
expect_length(wb$vml, 3)
expect_length(wb$vml_rels, 3)
expect_length(wb$vml_rels[[1]], 2)
expect_null(wb$vml_rels[[2]])
expect_length(wb$vml_rels[[3]], 1)
})
test_that("More than two background images work", {
tmp <- tempfile(fileext = ".png")
png(filename = tmp, bg = "transparent")
plot(1:10)
dev.off()
c1 <- wb_comment(text = "Comm1", author = "", visible = TRUE)
wb <- wb_workbook()$
add_worksheet()$
add_comment(dims = "A2", comment = c1, file = tmp)$
add_comment(dims = "A3", comment = c1, file = tmp)$
add_comment(dims = "A4", comment = c1, file = tmp)$
add_worksheet()$
add_comment(dims = "A2", comment = c1, file = tmp)
exp <- list(
c(
"",
"",
""
),
""
)
got <- wb$vml_rels
expect_equal(exp, got)
})
test_that("background colors work", {
wb <- wb_workbook()$add_worksheet()
txt <- fmt_txt("This Part Bold red\n\n", bold = TRUE, size = 12, color = wb_color("red")) +
fmt_txt("This part black", size = 9, color = wb_color("black"))
wb$add_comment(sheet = 1, dims = wb_dims(3, 6), comment = wb_comment(text = txt), color = wb_color("green"))
expect_match(wb$vml[[1]], "fillcolor=\"#00FF00\"")
})