Merge pull request #362 from sdcTools/feature-remove-shinybs

remove shinyBS dependency in `sdcApp`

Author: matthias-da

DESCRIPTION

@@ -50,7 +50,6 @@ Imports:
     haven,
     rhandsontable,
     DT,
-    shinyBS,
     prettydoc,
     VIM (>= 4.7.0),
     httr,

NAMESPACE

@@ -94,7 +94,6 @@ import(methods)
 import(rhandsontable)
 import(robustbase)
 import(shiny)
-import(shinyBS)
 import(tools)
 import(xtable)
 importFrom(DT,datatable)

NEWS

@@ -1,5 +1,6 @@
 # 5.7.10
 - fix inconsistency in `rankSwap()` Output [Issue #361]
+- remove shinyBS dependency in `sdcApp`
 
 # 5.7.9
 - Improvements for `recordSwap()`:

R/0classes.r

@@ -11,7 +11,6 @@
 #' @import xtable
 #' @import data.table
 #' @import ggplot2
-#' @import shinyBS
 #' @import shiny
 #' @import rhandsontable
 #' @importFrom DT datatable

inst/shiny/sdcApp/global.R

@@ -3,7 +3,6 @@ library(grid)
 library(sdcMicro)
 library(rhandsontable)
 library(haven)
-library(shinyBS)
 library(data.table)
 
 if (!getShinyOption("sdcAppInvoked", FALSE)) {### Beginning required code for deployment
@@ -233,6 +232,40 @@ summaryfn <- function(x) {
   vv
 }
 
+# to get rid of the shinyBS dependency
+tipify <- function(el, title, placement = "bottom", trigger = "hover", options = NULL) {
+  # generate a unique ID for the wrapper element and wrap element in span-tag
+  wrapper_id <- paste0("tip-", round(runif(1, 1e9, 9e9)), "-", as.integer(Sys.time()))
+  wrapped_el <- tags$span(id = wrapper_id, el)
+
+  # define the JS options, forcing html: true allows to render inline-html code
+  js_options <- list(
+    html = TRUE
+  )
+  if (!is.null(options)) {
+    js_options <- c(js_options, options)
+  }
+
+  # add req. attributes
+  wrapped_el <- htmltools::tagAppendAttributes(
+    wrapped_el,
+    "data-toggle" = "tooltip",
+    "data-placement" = placement,
+    "data-trigger" = trigger
+  )
+
+  # the attribute should be treated as html-content
+  wrapped_el$attribs$title <- htmltools::HTML(title)
+
+  # the js-script to initialize the tooltip using the generated id
+  init_script <- tags$script(HTML(paste0(
+    "$(document).ready(function() { $('#", wrapper_id, "').tooltip(",
+      jsonlite::toJSON(js_options, auto_unbox = TRUE),
+    ");});"
+  )))
+  return(tagList(wrapped_el, init_script))
+}
+
 # global, reactive data-structure
 data(testdata, envir = .GlobalEnv)
 data(testdata2, envir = .GlobalEnv)