adds svg plot option

R/content-types.R

@@ -64,7 +64,7 @@ getCharacterSet <- function(contentType){
   as.character(
     ifelse(
       charsetStart > -1,
-      substr(contentType, charsetStart, nchar(contentType)), 
+      substr(contentType, charsetStart, nchar(contentType)),
       default
     )
   )

R/images.R

@@ -1,6 +1,6 @@
-#' @param imageFun The function to call to setup the image device (e.g. `png`)
-#' @param args A list of supplemental arguments to be passed into jpeg()
-#' @importFrom grDevices dev.off jpeg png
+#' @param imageFun The function to call to setup the image device (`png`, `jpeg` or `svg`)
+#' @param args A list of supplemental arguments to be passed into png(), jpeg() or svg()
+#' @importFrom grDevices dev.off jpeg png svg
 #' @noRd
 render_image <- function(imageFun, contentType, args=NULL){
   list(
@@ -31,3 +31,7 @@ render_jpeg <- function(args){
 render_png <- function(args){
   render_image(png, "image/png", args)
 }
+
+render_svg <- function(args){
+  render_image(svg, "image/svg+xml", args)
+}

R/parse-block.R

@@ -149,7 +149,7 @@ parseBlock <- function(lineNum, file){
 
     }
 
-    imageMat <- stringi::stri_match(line, regex="^#['\\*]\\s*@(jpeg|png)([\\s\\(].*)?\\s*$")
+    imageMat <- stringi::stri_match(line, regex="^#['\\*]\\s*@(jpeg|png|svg)([\\s\\(].*)?\\s*$")
     if (!is.na(imageMat[1,1])){
       if (!is.null(image)){
         # Must have already assigned.
@@ -262,6 +262,8 @@ evaluateBlock <- function(srcref, file, expr, envir, addEndpoint, addFilter, mou
           ep$registerHooks(render_png(imageArgs))
         } else if (block$image == "jpeg"){
           ep$registerHooks(render_jpeg(imageArgs))
+        } else if (block$image == "svg"){
+          ep$registerHooks(render_svg(imageArgs))
         } else {
           stop("Image format not found: ", block$image)
         }

tests/testthat/files/image.R

@@ -10,6 +10,11 @@ function() {
   plot(1:10)
 }
 
+#* @svg
+#* @get /svg
+function() {
+  plot(1:10)
+}
 
 #' @png (width = 150, height=150)
 #' @get /littlepng

tests/testthat/test-image.R

@@ -26,6 +26,10 @@ test_that("Images are properly rendered", {
   expect_equal(resp$headers$`Content-type`, "image/jpeg")
   expect_gt(length(resp$body), 100) # This changes based on R ver/OS, may not be useful.
   expect_lt(length(resp$body), fullsizeJPEG) # Should be smaller than the full one
+
+  resp <- r$serve(make_req("GET", "/svg"), PlumberResponse$new())
+  expect_equal(resp$status, 200)
+  expect_equal(resp$headers$`Content-type`, "image/svg+xml") # without +xml doesn't work in firefox
 })
 
 test_that("render_image arguments supplement", {