[pt] initial support for timelines (#1016)

* [pt] initial support for timelines * [clone] update clone logic for drawings and add basic tests * [clone] fix cloning images * cleanup
JanMarvin · May 11, 2024 · 3b20f3c · 3b20f3c
1 parent 01f91de
commit 3b20f3c
Show file tree

Hide file tree

Showing 8 changed files with 205 additions and 24 deletions.
diff --git a/NEWS.md b/NEWS.md
@@ -6,10 +6,14 @@
 
 * Silence a warning triggered by a folder called `"[trash]"`. [1012](https://github.com/JanMarvin/openxlsx2/pull/1012)
 
+* Initial support for pivot table timelines. [1016](https://github.com/JanMarvin/openxlsx2/pull/1016)
+
 ## Fixes
 
 * Fixed an issue with non consecutive dims, where columns or rows were silently dropped. [1015](https://github.com/JanMarvin/openxlsx2/pull/1015)
 
+* Fixes to `wb_clone_worksheet()` cloning drawings and images should be restored. [1016](https://github.com/JanMarvin/openxlsx2/pull/1016)
+
 
 ***************************************************************************
 

diff --git a/R/baseXML.R b/R/baseXML.R
@@ -504,6 +504,15 @@ genSlicerCachesExtLst <- function(i) {
   )
 }
 
+genTimelineCachesExtLst <- function(i) {
+  paste0(
+    '<ext uri=\"{D0CA8CA8-9F24-4464-BF8E-62219DCF47F9}\" xmlns:x15=\"http://schemas.microsoft.com/office/spreadsheetml/2010/11/main\">
+    <x15:timelineCacheRefs>',
+    paste(sprintf('<x15:timelineCacheRef r:id="rId%s"/>', i), collapse = ""),
+    "</x15:timelineCacheRefs></ext>"
+  )
+}
+
 
 colors1_xml <- "<cs:colorStyle xmlns:cs=\"http://schemas.microsoft.com/office/drawing/2012/chartStyle\" xmlns:a=\"http://schemas.openxmlformats.org/drawingml/2006/main\" meth=\"cycle\" id=\"10\">
 <a:schemeClr val=\"accent1\"/>

diff --git a/R/class-chart-sheet.R b/R/class-chart-sheet.R
@@ -65,13 +65,14 @@ wbChartSheet <- R6::R6Class(
       self$sheetViews  <- character()
       self$pageMargins <- '<pageMargins left="0.7" right="0.7" top="0.75" bottom="0.75" header="0.3" footer="0.3"/>'
       self$drawing     <- '<drawing r:id=\"rId1\"/>'
-      self$relships              <- list(
+      self$relships    <- list(
         comments         = integer(),
         drawing          = integer(),
         pivotTable       = integer(),
         slicer           = integer(),
         table            = integer(),
         threadedComments = integer(),
+        timeline         = integer(),
         vmlDrawing       = integer()
       )
 

diff --git a/R/class-workbook.R b/R/class-workbook.R
@@ -187,6 +187,12 @@ wbWorkbook <- R6::R6Class(
     #' @field threadComments Threaded comments
     threadComments = NULL,
 
+    #' @field timelines timelines
+    timelines = NULL,
+
+    #' @field timelineCaches timelineCaches
+    timelineCaches = NULL,
+
     #' @field workbook workbook
     workbook = genBaseWorkbook(),
 
@@ -302,9 +308,6 @@ wbWorkbook <- R6::R6Class(
 
       self$richData <- NULL
 
-      self$slicers <- NULL
-      self$slicerCaches <- NULL
-
       self$sheet_names <- character()
       self$sheetOrder <- integer()
 
@@ -880,17 +883,10 @@ wbWorkbook <- R6::R6Class(
       ## create sheet.rels to simplify id assignment
       self$worksheets_rels[[newSheetIndex]] <- from$worksheets_rels[[old]]
 
-      old_drawing_sheet <- NULL
-
-      if (length(from$worksheets_rels[[old]])) {
-        relship <- rbindlist(xml_attr(from$worksheets_rels[[old]], "Relationship"))
-        relship$typ <- basename(relship$Type)
-        old_drawing_sheet  <- as.integer(gsub("\\D+", "", relship$Target[relship$typ == "drawing"]))
-      }
-
-      if (length(old_drawing_sheet) && length(from$worksheets[[old_drawing_sheet]]$relships$drawing)) {
+      new_drawing_sheet <- NULL
+      if (length(from$worksheets[[old]]$relships$drawing)) {
 
-        drawing_id <- from$worksheets[[old_drawing_sheet]]$relships$drawing
+        drawing_id <- from$worksheets[[old]]$relships$drawing
 
         new_drawing_sheet <- length(self$drawings) + 1L
 
@@ -955,7 +951,6 @@ wbWorkbook <- R6::R6Class(
             USE.NAMES = FALSE
           )
 
-
         self$append("drawings", from$drawings[[drawing_id]])
       }
 
@@ -975,7 +970,9 @@ wbWorkbook <- R6::R6Class(
 
         newid <- length(self$slicers) + 1
 
-        cloned_slicers <- from$slicers[[old]]
+        old_s_id <- from$worksheets[[old]]$relships$slicer
+
+        cloned_slicers <- from$slicers[[old_s_id]]
         slicer_attr <- xml_attr(cloned_slicers, "slicers")
 
         # Replace name with name_n. This will prevent the slicer from loading,
@@ -987,6 +984,8 @@ wbWorkbook <- R6::R6Class(
 
         self$slicers[[newid]] <- xml_node_create("slicers", slicer_child, slicer_attr[[1]])
 
+        self$worksheets[[newSheetIndex]]$relships$slicer <- newid
+
         self$worksheets_rels[[newSheetIndex]] <- c(
           self$worksheets_rels[[newSheetIndex]],
           sprintf("<Relationship Id=\"rId%s\" Type=\"http://schemas.microsoft.com/office/2007/relationships/slicer\" Target=\"../slicers/slicer%s.xml\"/>",
@@ -1001,6 +1000,43 @@ wbWorkbook <- R6::R6Class(
 
       }
 
+      rid <- as.integer(sub("\\D+", "", get_relship_id(obj = self$worksheets_rels[[newSheetIndex]], "timeline")))
+      if (length(rid)) {
+
+        warning("Cloning timelines is not yet supported. It will not appear on the sheet.")
+        self$worksheets_rels[[newSheetIndex]] <- relship_no(obj = self$worksheets_rels[[newSheetIndex]], x = "timeline")
+
+        newid <- length(self$timelines) + 1L
+
+        old_t_id <- from$worksheets[[old]]$relships$timeline
+
+        cloned_timelines <- from$timelines[[old_t_id]]
+        timeline_attr <- xml_attr(cloned_timelines, "timelines")
+
+        # Replace name with name_n. This will prevent the timeline from loading,
+        # but the xlsx file is not broken
+        timeline_child <- xml_node(cloned_timelines, "timelines", "timeline")
+        timeline_df <- rbindlist(xml_attr(timeline_child, "timeline"))[c("name", "xr10:uid", "cache", "caption", "level", "selectionLevel", "scrollPosition")]
+        timeline_df$name <- paste0(timeline_df$name, suffix)
+        timeline_child <- df_to_xml("timeline", timeline_df)
+
+        self$timelines[[newid]] <- xml_node_create("timelines", timeline_child, timeline_attr[[1]])
+
+        self$worksheets[[newSheetIndex]]$relships$timeline <- newid
+
+        self$worksheets_rels[[newSheetIndex]] <- c(
+          self$worksheets_rels[[newSheetIndex]],
+          sprintf("<Relationship Id=\"rId%s\" Type=\"http://schemas.microsoft.com/office/2011/relationships/timeline\" Target=\"../timelines/timeline%s.xml\"/>",
+                  rid,
+                  newid)
+        )
+
+        self$Content_Types <- c(
+          self$Content_Types,
+          sprintf("<Override PartName=\"/xl/timelines/timeline%s.xml\" ContentType=\"application/vnd.ms-excel.timeline+xml\"/>", newid)
+        )
+      }
+
       if (!is.null(self$richData)) {
         warning("Cloning richData (e.g., cells with picture) is not yet supported. The output file will be broken.")
       }
@@ -1041,7 +1077,7 @@ wbWorkbook <- R6::R6Class(
 
       rid <- as.integer(sub("\\D+", "", get_relship_id(obj = self$worksheets_rels[[newSheetIndex]], x = "drawing")))
 
-      if (length(rid)) {
+      if (length(rid) && !is.null(new_drawing_sheet)) {
 
         self$worksheets_rels[[newSheetIndex]] <- relship_no(obj = self$worksheets_rels[[newSheetIndex]], x = "drawing")
 
@@ -1146,14 +1182,19 @@ wbWorkbook <- R6::R6Class(
             self$append("Content_Types", "<Default Extension=\"jpg\" ContentType=\"image/jpg\"/>")
           }
 
-          # from$worksheet[[old]]$relships$drawing
-          new_drawing_sheet <- self$worksheets[[newSheetIndex]]$relships$drawing
+          # get old drawing id, must not match new drawing id
+          old_drawing_sheet <- from$worksheets[[old]]$relships$drawing
 
-          if (length(new_drawing_sheet)) {
+          if (length(old_drawing_sheet)) {
+
+            # assuming that if drawing was copied, this is the new drawing id
+            new_drawing_sheet <- length(self$drawings)
+            self$worksheets[[newSheetIndex]]$relships$drawing <- new_drawing_sheet
 
             # we pick up the drawing relationship. This is something like: "../media/image1.jpg"
             # because we might end up with multiple files with similar names, we have to rename
             # the media file and update the drawing relationship
+            # TODO has every drawing a drawing_rel of the same size?
             drels <- rbindlist(xml_attr(self$drawings_rels[[new_drawing_sheet]], "Relationship"))
             if (ncol(drels) && any(basename(drels$Type) == "image")) {
               sel <- basename(drels$Type) == "image"
@@ -1181,7 +1222,7 @@ wbWorkbook <- R6::R6Class(
               )
 
               # append media
-              self$media <- append(self$media, media_names)
+              self$append("media", media_names)
             }
           }
         }
@@ -1254,6 +1295,10 @@ wbWorkbook <- R6::R6Class(
         }
 
         # TODO dxfs styles for (pivot) table styles and conditional formatting
+        if (length(from$styles_mgr$get_dxf())) {
+          msg <- "Input file has dxf styles. These are not cloned. Some styles might be broken and spreadsheet software might complain."
+          warning(msg, call. = FALSE)
+        }
 
         clone_shared_strings(from, old, self, newSheetIndex)
       }
@@ -2090,6 +2135,7 @@ wbWorkbook <- R6::R6Class(
       nThemes         <- length(self$theme)
       nPivots         <- length(self$pivotDefinitions)
       nSlicers        <- length(self$slicers)
+      nTimelines      <- length(self$timelines)
       nComments       <- length(self$comments)
       nThreadComments <- sum(lengths(self$threadComments) > 0)
       nPersons        <- length(self$persons)
@@ -2255,6 +2301,26 @@ wbWorkbook <- R6::R6Class(
         }
       }
 
+      # timelines
+      if (nTimelines) {
+        timelinesDir      <- dir_create(tmpDir, "xl", "timelines")
+        timelineCachesDir <- dir_create(tmpDir, "xl", "timelineCaches")
+
+        timeline <- self$timelines[self$timelines != ""]
+        for (i in seq_along(timeline)) {
+          write_file(
+            body = timeline[i],
+            fl = file.path(timelinesDir, sprintf("timeline%s.xml", i))
+          )
+        }
+
+        for (i in seq_along(self$timelineCaches)) {
+          write_file(
+            body = self$timelineCaches[[i]],
+            fl = file.path(timelineCachesDir, sprintf("timelineCache%s.xml", i))
+          )
+        }
+      }
 
       ## Write content
 
@@ -4119,6 +4185,11 @@ wbWorkbook <- R6::R6Class(
         self$workbook.xml.rels <- self$workbook.xml.rels[!grepl(sprintf("(slicerCache%s\\.xml)", sheet), self$workbook.xml.rels)]
       }
 
+      if (any(grepl("timelines", self$worksheets_rels[[sheet]]))) {
+        # don't change to a grep(value = TRUE)
+        self$workbook.xml.rels <- self$workbook.xml.rels[!grepl(sprintf("(timelineCache%s\\.xml)", sheet), self$workbook.xml.rels)]
+      }
+
       ## wont't remove tables and then won't need to reassign table r:id's but will rename them!
       self$worksheets[[sheet]] <- NULL
       self$worksheets_rels[[sheet]] <- NULL
@@ -9024,6 +9095,7 @@ wbWorkbook <- R6::R6Class(
       ## don't want to re-assign rIds for pivot tables or slicer caches
       pivotNode        <- grep("pivotCache/pivotCacheDefinition[0-9]+.xml", self$workbook.xml.rels, value = TRUE)
       slicerNode       <- grep("slicerCache[0-9]+.xml",                     self$workbook.xml.rels, value = TRUE)
+      timelineNode     <- grep("timelineCache[0-9]+.xml",                   self$workbook.xml.rels, value = TRUE)
 
       ## Reorder children of workbook.xml.rels
       self$workbook.xml.rels <-
@@ -9054,7 +9126,7 @@ wbWorkbook <- R6::R6Class(
           }
         )
 
-      self$append("workbook.xml.rels", c(pivotNode, slicerNode))
+      self$append("workbook.xml.rels", c(pivotNode, slicerNode, timelineNode))
 
       if (length(self$metadata)) {
         self$append("workbook.xml.rels",

diff --git a/R/class-worksheet.R b/R/class-worksheet.R
@@ -236,6 +236,7 @@ wbWorksheet <- R6::R6Class(
         slicer           = integer(),
         table            = integer(),
         threadedComment  = integer(),
+        timeline         = integer(),
         vmlDrawing       = integer()
       )
 

diff --git a/R/wb_load.R b/R/wb_load.R
@@ -198,6 +198,10 @@ wb_load <- function(
   slicerXML         <- grep_xml("slicer[0-9]+.xml$")
   slicerCachesXML   <- grep_xml("slicerCache[0-9]+.xml$")
 
+  ## timelines
+  timelineXML         <- grep_xml("timeline[0-9]+.xml$")
+  timelineCachesXML   <- grep_xml("timelineCache[0-9]+.xml$")
+
   ## VBA Macro
   vbaProject        <- grep_xml("vbaProject\\.bin$")
 
@@ -217,7 +221,8 @@ wb_load <- function(
     "customXml", "docProps", "drawings", "embeddings", "externalLinks",
     "media", "persons", "pivotCache", "pivotTables", "printerSettings",
     "queryTables", "richData", "slicerCaches", "slicers", "tables", "theme",
-    "threadedComments", "worksheets", "xl", "[trash]"
+    "threadedComments", "timelineCaches", "timelines", "worksheets", "xl",
+    "[trash]"
   )
   unknown <- file_folders[!file_folders %in% known]
   # nocov start
@@ -1029,6 +1034,7 @@ wb_load <- function(
       slcrs <- integer()
       table <- integer()
       trcmt <- integer()
+      tmlne <- integer()
       vmldr <- integer()
 
       if (ncol(wb_rels)) {
@@ -1042,6 +1048,7 @@ wb_load <- function(
         slcrs <- wb_rels$tid[wb_rels$typ == "slicer"]
         table <- wb_rels$tid[wb_rels$typ == "table"]
         trcmt <- wb_rels$tid[wb_rels$typ == "threadedComment"]
+        tmlne <- wb_rels$tid[wb_rels$typ == "timeline"]
         vmldr <- wb_rels$tid[wb_rels$typ == "vmlDrawing"]
       }
 
@@ -1054,6 +1061,7 @@ wb_load <- function(
         slicer           = slcrs,
         table            = table,
         threadedComment  = trcmt,
+        timeline         = tmlne,
         vmlDrawing       = vmldr
       )
     }
@@ -1098,6 +1106,44 @@ wb_load <- function(
       wb$workbook$extLst <- xml_node_create("extLst", xml_children = ext)
     }
 
+    ## Timeline -------------------------------------------------------------------------------------
+    if (length(timelineXML)) {
+
+      # maybe these need to be sorted?
+      # timelineXML <- timelineXML[order(nchar(timelineXML), timelineXML)] ???
+
+      wb$timelines <- vapply(timelineXML, read_xml, pointer = FALSE,
+                             FUN.VALUE = NA_character_, USE.NAMES = FALSE)
+
+      ## worksheet_rels Id for timeline will be rId0
+      for (i in seq_along(wb$timelines)) {
+
+        # this will add timelines to Content_Types. Ergo if worksheets with
+        # timelines are removed, the timeline needs to remain in the worksheet
+        wb$append(
+          "Content_Types",
+          sprintf('<Override PartName="/xl/timelines/timeline%s.xml" ContentType="application/vnd.ms-excel.timeline+xml"/>', i)
+        )
+      }
+    }
+
+    ## ---- timelineCaches
+    if (length(timelineCachesXML)) {
+      wb$timelineCaches <- vapply(timelineCachesXML, read_xml, pointer = FALSE,
+                                  FUN.VALUE = NA_character_, USE.NAMES = FALSE)
+
+      for (i in seq_along(wb$timelineCaches)) {
+        wb$append("Content_Types", sprintf('<Override PartName="/xl/timelineCaches/timelineCache%s.xml" ContentType="application/vnd.ms-excel.timelineCache+xml"/>', i))
+        wb$append("workbook.xml.rels", sprintf('<Relationship Id="rId%s" Type="http://schemas.microsoft.com/office/2011/relationships/timelineCache" Target="timelineCaches/timelineCache%s.xml"/>', 2E5 + i, i))
+      }
+
+      # get extLst object. select the timelineCaches and replace it
+      ext_nams <- xml_node_name(wb$workbook$extLst, "extLst", "ext")
+      is_timeline <- which(ext_nams == "x15:timelineCacheRefs")
+      ext <- xml_node(wb$workbook$extLst, "extLst", "ext")
+      ext[is_timeline] <- genTimelineCachesExtLst(2E5 + seq_along(timelineCachesXML))
+      wb$workbook$extLst <- xml_node_create("extLst", xml_children = ext)
+    }
 
     ## Tables --------------------------------------------------------------------------------------
     if (length(tablesXML)) {