RStudio addin to define new panels.

.Rbuildignore

@@ -1,3 +1,5 @@
+^renv$
+^renv\.lock$
 ^.*\.Rproj$
 ^\.Rproj\.user$
 ^LICENSE\.md$

DESCRIPTION

@@ -59,15 +59,16 @@ Suggests:
     rmarkdown,
     BiocStyle,
     htmltools,
+    rstudioapi,
     Rtsne,
     uwot,
     testthat (>= 2.1.0),
     covr
 URL: https://github.com/iSEE/iSEEu
 BugReports: https://github.com/iSEE/iSEEu/issues
+RoxygenNote: 7.1.1
 biocViews: ImmunoOncology, Visualization, GUI, DimensionReduction, 
     FeatureExtraction, Clustering, Transcription, 
     GeneExpression, Transcriptomics, SingleCell, CellBasedAssays
-RoxygenNote: 7.1.1
 Roxygen: list(markdown = TRUE)
 VignetteBuilder: knitr

NAMESPACE

@@ -30,6 +30,7 @@ export(getTableExtraFields)
 export(modeEmpty)
 export(modeGating)
 export(modeReducedDim)
+export(new_panel_file)
 export(setAveAbPattern)
 export(setFeatureSetCommands)
 export(setLogFCPattern)
@@ -106,6 +107,8 @@ importFrom(iSEE,ReducedDimensionPlot)
 importFrom(iSEE,RowDataTable)
 importFrom(iSEE,iSEE)
 importFrom(methods,callNextMethod)
+importFrom(methods,extends)
+importFrom(methods,getClasses)
 importFrom(methods,is)
 importFrom(methods,new)
 importFrom(shiny,hr)

R/addin.R

@@ -0,0 +1,59 @@
+#' New iSEE panel class addin.
+#'
+#' Runs the addin miniUI to create a new iSEE panel class.
+#'
+#' @return `NULL`, invisibly.
+#'
+#' @author Kevin Rue-Albrecht
+#'
+#' @rdname INTERNAL_new_panel_addin
+new_panel_addin = function() {
+  sys.source(system.file(package = 'iSEEu', 'scripts', 'new_panel.R'))
+}
+
+#' List available parent classes for new iSEE panel classes
+#'
+#' Collects the list of classes - both virtual and concrete - defined in either [iSEE::iSEE-pkg] or `iSEEu`, and that extend the [iSEE::Panel-class].
+#'
+#' @return A character vector of S4 class names.
+#'
+#' @author Kevin Rue-Albrecht
+#'
+#' @rdname INTERNAL_collect_parent_classes
+#' @importFrom methods extends getClasses
+collect_parent_classes <- function() {
+	x <- unique(c(getClasses("package:iSEE"), getClasses("package:iSEEu")))
+	is_panel <- function(Class) {
+		extends(Class, "Panel")
+	}
+	keep <- vapply(x, is_panel, FUN.VALUE = logical(1))
+	x[keep]
+}
+
+#' Create a new panel class file
+#'
+#' Opens a template R script in the editor, to define a new iSEE panel class .
+#'
+#' @param encoded Name of the new panel class.
+#' @param decoded Extended name of the new panel class (for display).
+#' @param parent Name of the parent panel class
+#'
+#' @export
+#'
+#' @author Kevin Rue-Albrecht
+#'
+#' @seealso \linkS4class{Panel}
+#'
+#' @examples
+#' if (Sys.getenv("RSTUDIO") == "1") {
+#'     new_panel_file("NewRedDimPlot", "New reduced dimension plot", "RedDimPlot")
+#' }
+new_panel_file <- function(encoded, decoded, parent="Panel") {
+  template_file <- system.file(package = "iSEEu", "templates", "NewPanel.R")
+  template_content <- scan(template_file, "character", sep = "\n", quiet = TRUE, blank.lines.skip = FALSE)
+  template_content <- paste0(template_content, collapse = "\n")
+  template_content <- gsub("__ENCODED__", encoded, template_content, fixed = TRUE)
+  template_content <- gsub("__DECODED__", decoded, template_content, fixed = TRUE)
+  template_content <- gsub("__PARENT__", parent, template_content, fixed = TRUE)
+  rstudioapi::documentNew(template_content, type = "r")
+}

inst/rstudio/addins.dcf

@@ -0,0 +1,4 @@
+Name: New iSEE Panel
+Description: Create a new panel class with iSEE::new_panel().
+Binding: new_panel_addin
+Interactive: true

inst/scripts/new_panel.R

@@ -0,0 +1,45 @@
+# Adapted from https://github.com/rstudio/blogdown/blob/master/inst/scripts/new_post.R
+local({
+  txt_input = function(..., width = '100%') shiny::textInput(..., width = width)
+  sel_input = function(...) shiny::selectizeInput(
+    ..., width = '98%', multiple = FALSE, options = list(create = TRUE)
+  )
+  parent_choices = sort(iSEEu:::collect_parent_classes())
+  shiny::runGadget(
+    miniUI::miniPage(miniUI::miniContentPanel(
+      txt_input('encoded', 'Class encoded name', placeholder = 'MyNewPlot'),
+      txt_input('decoded', 'Class decoded name', placeholder = 'My New Plot'),
+      shiny::fillRow(
+        sel_input('parentclass', 'Parent class', parent_choices, selected="Panel"),
+        height = '70px'
+      ),
+      miniUI::gadgetTitleBar(NULL)
+    )),
+    server = function(input, output, session) {
+
+      shiny::observeEvent(input$done, {
+        encoded <- input$encoded
+        decoded <- input$decoded
+        parentclass <- input$parentclass
+
+        if (grepl('^\\s*$', encoded)) return(
+          warning('The decoded class name is empty!', call. = FALSE)
+        )
+        if (grepl('^\\s*$', decoded)) return(
+          warning('The encoded class name is empty!', call. = FALSE)
+        )
+        if (grepl('^\\s*$', parentclass)) return(
+          warning('The parent class name is empty!', call. = FALSE)
+        )
+
+        iSEEu::new_panel_file(encoded, decoded, parentclass)
+        shiny::stopApp()
+      })
+
+      shiny::observeEvent(input$cancel, {
+        shiny::stopApp()
+      })
+    },
+    stopOnCancel = FALSE, viewer = shiny::dialogViewer('New Post', height = 500)
+  )
+})

inst/templates/NewPanel.R

@@ -0,0 +1,101 @@
+setClass("__ENCODED__", contains="__PARENT__")
+
+#' Panel name
+#'
+#' Panel description
+#'
+#' @section Constructor:
+#' \code{__ENCODED__()} creates an instance of a __ENCODED__ class.
+#'
+#' @author Author name
+#'
+#' @examples
+#' #################
+#' # For end-users #
+#' #################
+#'
+#' x <- __ENCODED__()
+#'
+#' ##################
+#' # For developers #
+#' ##################
+#'
+#'
+#' library(scater)
+#' sce <- mockSCE()
+#' sce <- logNormCounts(sce)
+#'
+#' # Replaces the default with something sensible.
+#' sce <- runPCA(sce)
+#' sce0 <- .cacheCommonInfo(x, sce)
+#' .refineParameters(x, sce0)
+#'
+#' @docType methods
+#' @aliases __ENCODED__ __ENCODED__-class
+#' .defineParamInterface,__ENCODED__-method
+#' .createParamObservers,__ENCODED__-method
+#' @name __ENCODED__
+NULL
+
+#' @export
+__ENCODED__ <- function() {
+    new("__ENCODED__")
+}
+
+#' @export
+#' @importFrom methods callNextMethod
+setMethod("initialize", "__ENCODED__", function(.Object, ...) {
+    .Object <- callNextMethod(.Object, ...)
+    .Object
+})
+
+#' @export
+#' @importFrom methods callNextMethod
+setMethod(".cacheCommonInfo", "__ENCODED__", function(x, se) {
+    callNextMethod()
+})
+
+#' @export
+#' @importFrom methods callNextMethod
+setMethod(".refineParameters", "__ENCODED__", function(x, se) {
+    x <- callNextMethod()
+    x
+})
+
+#' @importFrom S4Vectors setValidity2
+setValidity2("__ENCODED__", function(object) {
+    msg <- character(0)
+
+    if (length(msg)>0) {
+        return(msg)
+    }
+    TRUE
+})
+
+#' @export
+#' @importFrom methods callNextMethod
+setMethod(".defineParamInterface", "__ENCODED__", function(x, se, active_panels) {
+    callNextMethod()
+})
+
+#' @export
+#' @importFrom methods callNextMethod
+setMethod(".createParamObservers", "__ENCODED__", function(x, se, input, session, pObjects, rObjects) {
+    callNextMethod()
+})
+
+#' @export
+setMethod(".get__ENCODED__", "__ENCODED__", function(x) "__ENCODED__")
+
+#' @export
+setMethod(".getFullName", "__ENCODED__", function(x) "__DECODED__")
+
+#' @export
+setMethod(".getCommandsDataXY", "__ENCODED__", function(x, param_choices) {
+    callNextMethod()
+})
+
+#' @export
+setMethod(".getCommandsPlot", "__ENCODED__", function(x, param_choices, plot_data, plot_type, labs, is_subsetted, is_downsampled) {
+    callNextMethod()
+})

man/.gitignore

@@ -0,0 +1 @@
+INTERNAL_*