inst/TBploter/extraWedget.R

In likelet/PlotAppForTBtools: Plot server for TBtools Output

library(shinyBS)
library(shiny)

NiePrettyDownloadButton<-function(inputID,addclass="",inputstring=""){
  classstr= paste("btn shiny-download-link",addclass,sep=" ")
  tags$a(id=inputID,
         class=classstr,
         href="",
         target="_blank",
         tags$i(class="glyphicon glyphicon-save"),
         inputstring
  )
}
NiePrettyActionButton<-function(inputID,addclass="",inputstring=""){
  classstr= paste("btn action-button",addclass,sep=" ")
  tags$a(id=inputID,
         class=classstr,
         href="",
         target="_blank",
         tags$i(class="fa fa-download"),
         inputstring
  )
}

DiaoTips<-function(number,title="",myplacement="right"){
  tipsid=paste("tipid",number,sep="_")
  tagList(
    tags$span(id=tipsid,class="glyphicon glyphicon-question-sign"),
    bsTooltip(tipsid, title, trigger="hover", placement=myplacement)
  )
}
Diaopopover<-function(number,title="",myplacement="right"){
  tipsid=paste("popid",number,sep="_")
  tagList(
    tags$span(id=tipsid,class="glyphicon glyphicon-question-sign"),
    bsTooltip(tipsid, title, trigger="hover", placement=myplacement)
  )
}
#draggable panel which is not conflicted with shinyBS tooltips
absoluteP2<-function (..., top = NULL, left = NULL, right = NULL, bottom = NULL, 
                      width = NULL, height = NULL, draggable = FALSE, fixed = FALSE, 
                      cursor = c("auto", "move", "default", "inherit")) 
{
  cssProps <- list(top = top, left = left, right = right, bottom = bottom, 
                   width = width, height = height)
  cssProps <- cssProps[!sapply(cssProps, is.null)]
  cssProps <- sapply(cssProps, validateCssUnit)
  cssProps[["position"]] <- ifelse(fixed, "fixed", "absolute")
  cssProps[["cursor"]] <- match.arg(cursor)
  if (identical(cssProps[["cursor"]], "auto")) 
    cssProps[["cursor"]] <- ifelse(draggable, "move", "inherit")
  style <- paste(paste(names(cssProps), cssProps, sep = ":", 
                       collapse = ";"), ";", sep = "")
  divTag <- tags$div(style = style, ...)
  if (isTRUE(draggable)) {
    divTag <- tagAppendAttributes(divTag, class = "draggable")
    return(tagList(singleton(tags$head(tags$script(src = "js/jquery-ui.min.js"))), 
                   divTag, tags$script("$(\".draggable\").draggable({containment: \"parent\"});")))
  }
  else {
    return(divTag)
  }
}



newbusyIndicator<-function(){
  tagList(
    div(class="zbusy",
        p("Loading in progress......"),
        tags$img(style="text-align:center",src="shinysky/busyIndicator/ajaxloaderq.gif")
    )
  )
}