I have been using the approach suggested by #wch on SO to close the browser window when clicking an action button in a Shiny app. Works great.
I would now like to stop my app and close the bowser window (in Chrome) when clicking an element in the navbar. Below the tabPanel call I'm using
tabPanel(title = "", value = "Stop", icon = icon("power-off"))
I use an observer to stop the app when the value of input$navbar == "Stop" (i.e, when the icon in the navbar is selected) but I'm not sure how to activate the window.close() call.
Code for action button to close browser windows by #wch
tags$button(
id = 'close',
type = "button",
class = "btn action-button",
onclick = "window.close();",
"Close window"
)
EDIT:
Found a work-around that does what I want.
tabPanel(tags$a(id = "quitApp", href = "#", class = "action-button",
list(icon("power-off"), ""), onclick = "window.close();"))
Unfortunately it leads to a rather badly aligned navbar. I asked a related question on the Shiny google group
You can use the shinyjs package to easily call javascript functions, which is essentially all you need to do. Disclaimer: I wrote that package. Here's the code to do what you want:
library(shinyjs)
jscode <- "shinyjs.closewindow = function() { window.close(); }"
runApp(shinyApp(
ui = tagList(
useShinyjs(),
extendShinyjs(text = jscode),
navbarPage(
"test",
id = "navbar",
tabPanel(title = "tab1"),
tabPanel(title = "", value = "Stop", icon = icon("power-off"))
)
),
server = function(input, output, session) {
observe({
if (input$navbar == "Stop") {
js$closewindow();
stopApp()
}
})
}
))
EDIT:
If you don't want to use a JS package, you can do the same thing with native shiny:
jscode <- "Shiny.addCustomMessageHandler('closeWindow', function(m) {window.close();});"
runApp(shinyApp(
ui = tagList(
tags$head(tags$script(HTML(jscode))),
navbarPage(
"test",
id = "navbar",
tabPanel(title = "tab1"),
tabPanel(title = "", value = "Stop", icon = icon("power-off"))
)
),
server = function(input, output, session) {
observe({
if (input$navbar == "Stop") {
session$sendCustomMessage(type = "closeWindow", message = "message")
stopApp()
}
})
}
))
Related
I'm trying to add an external link to the tab panel title in a shiny navbar. The link itself works fine, but it moves the tab with the link into a separate row.
How can I include a link and maintain the placement of the tab in the same row as any other tabs that don't contain links?
Here is my minimalistic code:
library(shiny)
ui <- navbarPage(
title = "",
id = "navbar",
header = "",
tabsetPanel(id="tabs",
tabPanel(
title = "Tab1", value = "tab1"
),
tabPanel(
title = a("Tab2",
href = "https://www.google.com/"),
value = "tab2"
)
)
)
server <- function(input, output, session) {
}
shinyApp(ui, server)
I have tried using the HTML function to see if that for some reason gives a different result, but as expected it didn't:
tabPanel(
title = HTML("<a href = 'https://www.google.com/'>tab2</a>"),
value = "tab2"
)
I would really appreciate your advice!
If you also happen to have any idea on how to remove the title row from the navbarPage, that would also be much appreciated.
If you look at the HTML for your tabs, you can see that the tabs themselves already have a <a href ...> tag. So what you're doing is adding another one below the existing one.
A work-around is to do something like
Observe when Tab2 is pressed
Navigate to the URL
library(shiny)
ui <- navbarPage(
title = "",
id = "navbar",
header = "",
tabsetPanel(
id = "tabs",
tabPanel(title = "Tab1"),
tabPanel(title = "Tab2")
)
)
server <- function(input, output, session) {
observeEvent(input$tabs, {
print(input$tabs)
if( input$tabs == "Tab2" ) {
browseURL("https://www.google.com/")
}
})
}
shinyApp(ui, server)
One way to do this, is to use a javascript function to do the linking for us. Then we do not need to include <a href> inside the tab which is already a link!.
We can easily set up a Js function with {shinyjs} and extendShinyjs(). Then we call it in an observeEvent() when the tab is clicked.
library(shiny)
library(shinyjs)
ui <- navbarPage(
# use shinyjs
useShinyjs(),
# write JS function to open window
shinyjs::extendShinyjs(text = "shinyjs.myfun = function() { window.open('https://www.google.com/', '_self'); }",
functions = c("myfun")),
title = "",
id = "navbar",
header = "",
tabsetPanel(id="tabs",
tabPanel(
title = "Tab1", value = "tab1"
),
tabPanel(
title = "Tab2",
value = "tab2"
)
)
)
server <- function(input, output, session) {
# use observeEvent to check if user clicks tab no 2
observeEvent(input$tabs,
{
if (input$tabs == "tab2") {
shinyjs::js$myfun()
}
})
}
shinyApp(ui, server)
I would like to have one of the tabPanels in my Shiny app launch a shinyFiles style input. In this case I would like to launch a shinySaveButton, without the shinySaveButton being in my dataset (By clicking the save icon [which is actually a tabPanel])
Reproducible example below
library(shiny)
library(shinyFiles)
ui <- navbarPage('Test App',id = "inTabset", selected="panel1",
tabPanel(title = "", value = "Save", icon = icon("save")),
tabPanel(title = "Panel 1", value = "panel1",
h1("Panel1")),
tabPanel(title = "Panel 2",value = "panel2",
h1("Panel2"))
)
server <- function(input, output, session) {
values = reactiveValues(tabSelected="panel1")
observe({
if (input$inTabset=="Save") {
updateNavbarPage(session,"inTabset",selected=values$tabSelected)
#CODE FOR LOADING SHINYFILES DIALOG IN HERE
} else {
values$tabSelected<-input$inTabset
}
})
}
shinyApp(ui, server)
Any help would be greatly appreciated.
Work around using hidden element trick
library(shiny)
library(shinyFiles)
library(shinyjs)
jsCode<-"shinyjs.saveButton=function(){ $('#buttonFileSaveHidden').click(); }"
ui <- fluidPage(
useShinyjs(),
extendShinyjs(text = jsCode),
navbarPage('Test App',id = "inTabset", selected="panel1",
tabPanel(title = "", value = "Save", icon = icon("save")),
tabPanel(title = "Panel 1", value = "panel1",
h1("Panel1")
),
tabPanel(title = "Panel 2",value = "panel2",
h1("Panel2"))
),
# HIDDEN BUTTON TO INITIATE THE SAVE
hidden(shinySaveButton( "buttonFileSaveHidden",
label="",
title="Save as ...",
list('hidden_mime_type'=c("R")),
class='hiddenButton')),
wellPanel( #ONLY INCLUDED TO DISPLAY OF PATH INFO OF THE CHOICE
h3('Current save path info'),
tableOutput('table')
)
)
server <- function(input, output, session) {
values = reactiveValues(tabSelected="panel1")
observe({
if (input$inTabset=="Save") {
updateNavbarPage(session,"inTabset",selected=values$tabSelected)
#CODE FOR LOADING SHINYFILES DIALOG IN HERE
js$saveButton()
} else {
values$tabSelected<-input$inTabset
}
})
shinyFileSave(input, "buttonFileSaveHidden", session=session, roots=c(wd="~"), filetypes=c('R') ) #hidden
# GET THE SAVE PATH CHOICE AND RECORD IT IN fp.dt.rv
fp.dt.rv<-reactiveVal("")
observeEvent(input$buttonFileSaveHidden,{
fp.dt<-parseSavePath(c(wd='~'), input$buttonFileSaveHidden)
fp.dt.rv(fp.dt) #or just use to immediately write.
})
# ONLY TO DISPLAY THE SAVE CHOICE
output$table <- renderTable(fp.dt.rv())
}
shinyApp(ui, server)
I want to execute rest of shiny app code only when modal dialog box is closed. How can I achieve this?
Here simple code:
# ui.R
actionButton("loadData", label = "Button", icon = icon("mail-forward"))
# server.R
observeEvent(input$loadData, {
showModal(modalDialog(
title = modal.title,
textInput("newName", "Enter file name:", value = ""),
easyClose = TRUE,
footer = list(
actionButton("confirmName", "OK"),
modalButton("Cancel"))
))
# ...code to be executed after modal is closed...
})
Create an event handler that executes code when the OK action button has been clicked, and also closes the modal using removeModal.
library(shiny)
ui <- fluidPage(
actionButton("loadData", label = "Button", icon = icon("mail-forward")),
verbatimTextOutput("filename")
)
server <- function(input, output, session) {
observeEvent(input$loadData, {
showModal(modalDialog(
title = "title",
textInput("newName", "Enter file name:", value = ""),
easyClose = TRUE,
footer = list(
actionButton("confirmName", "OK"),
modalButton("Cancel"))
))
})
output$filename <- eventReactive(input$confirmName, {
message("Closing modal")
removeModal()
input$newName
})
}
shinyApp(ui, server)
There's an example of this in the docs: https://shiny.rstudio.com/reference/shiny/latest/modalDialog.html
I'm building a shiny app in which a query from textInput is made when the user clicks on the "search" action button. I'd like that button to be disabled if the textInput box is empty. I'm using shinyjs::toggleState() here, but I can't figure out what logic it needs to apply to see that the text box is empty. In my reproducible file below, the logic I put in place is is.null(input$query). I've also tried with is.na(input$query), length(input$query) == 0, and input$query == '', all without success What should I put there instead?
Here's the app.r file:
library(shiny)
library(shinyjs)
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
useShinyjs(),
textInput(inputId = "query", label = "Enter query:", value = ""),
actionButton(inputId = "search", label = "Search", icon = icon("search"))
),
mainPanel()
)
)
server <- function(input, output) {
observe({
toggleState("search", !is.null(input$query))
})
}
shinyApp(ui = ui, server = server)
Something like this do?
observe({
if(is.null(input$query) || input$query == ""){
disable("search")
}
else{
enable("search")
}
})
As per #Sagar you can also do:
observe({
toggleState("search", input$query != "" | is.null(input$query))
})
or
observeEvent(input$query,{
toggleState("search", input$query != "" | is.null(input$query))
})
At the moment the app ends when the user clicks on a button Q. I would like this app to end when the user clicks Quit on the navbar. Unfortunately I can't figure out how to do this. Will be thankful for any help!
EDIT:
It would be great to know how to shift Quit tab to the right :)
ui <- shinyUI(navbarPage(title = "Test",
tabPanel(title = "Content",
actionButton(inputId = "quit", label = "Quit")
),
tabPanel(title = "Quit", icon = icon("circle-o-notch"))
)
)
server <- shinyServer(function(input,output) {
observe({
if (input$quit == 1) stopApp()
})
})
shinyApp(ui, server)
The solution for your problem is to create an id for the navbar, with that, you can call observer like you did but changing the input. The only problem is to identificate that you need to create a new id for the navbarPage.
shinyApp(
ui = navbarPage(title = "Test", id="navbar",
tabPanel(title = "Content"),
tabPanel(title = "Quit", value="stop", icon = icon("circle-o-notch"))
), #Close UI
server = function(input,output,session) {
observe({
if (input$navbar == "stop")
stopApp()
})
} #Close server
) #Close shinyApp