I want to use shiny.i18n in my app, which uses tooltips to provide more information on certain elements (using two types of tooltips, either with tipify or bsTooltip). However, I could not find how to integrate both, and the tooltips are not rendered properly.
As an example, this:
library(shiny)
library(shinyjs)
library(shinyBS)
library(shiny.i18n)
i18n <- Translator$new(translation_csvs_path = "data_translation/")
i18n$set_translation_language("en")
ui <- fluidPage(
useShinyjs(),
shiny.i18n::usei18n(i18n),
div(style = "float: left;",
selectInput('selected_language',
i18n$t("Change language"),
choices = i18n$get_languages(),
selected = i18n$get_key_translation())
),
mainPanel(
i18n$t("This is some text without a tooltip"),
textOutput("Text"),
bsTooltip("Text",
i18n$t("This is some text"),
placement="right", trigger = "hover", options=list(container="body")),
tipify(
actionButton("Button", "", icon = icon("house-user")),
i18n$t("This is a button"),
placement="right", trigger = "hover", options=list(container="body"))
))
server <- function(input, output, session) {
observeEvent(input$selected_language, {
shiny.i18n::update_lang(session, input$selected_language)
})
output$Text <- renderText({i18n$t("This is some text with a tooltip")})
}
shinyApp(ui, server)
file translate_fr.csv:
"en","fr"
"Hello","Bonjour"
"This is some text without a tooltip","Ceci est un texte sans tooltip"
"This is some text with a tooltip","Ceci est un texte avec tooltip"
"This is a button", "Ceci est un bouton"
"This is some text", "Ceci est un texte"
"Change language","Changer de langue"
returns:
While the tooltip should just contain "This is a button". I'm quite new to these tools - what am I missing?
The Problem is that the tooltips and tipify do not support HTML. That is the reason why your tooltips display the raw HTML created by shiny.18n.
There are two ways to achieve what you want.
The first one is to use popovers from the shinyBS packages. These support HTML and will achieve the language feature you are looking for.
The other one is to render the tooltips on the serverside in shiny. This way no HTML will be involved in creating the translations. This way would allow you to even use tipify/tooltips you asked for.
The reason for this problem is, that shiny.18n has two kind of tricks to achieve the translations. The first one is one the browser side. As you displayed shiny.18n is wrapping a span tag around the translations, so that it can later be modified by using JavaScripts in the browser.
The other method is to render everything new on the server side. This way no HTML will be needed, as the process is happening not on the browser anyway.
Related
The following code can be used to show how I would want a tooltip to appear. If version=3 then the function in shinyBS works and produces the tooltip. However with version=4 it does not work. I don't want to use the shinyBS package as it seems it's still in dev mode and would rather just straight prefer to wrap my button with some HTML using tooltips from bootstrap directly as shown here.
I'm not having success in doing it this way and wonder if anyone can suggest a good way to get the tool top for my button just using the pure HTML?
library(shiny)
library(bslib)
library(shinyBS)
ui <- fluidPage(
navbarPage(
theme = bs_theme(bootswatch = "flatly", version = 4),
title = 'Methods',
tabPanel('One'),
),
mainPanel(
h1('Hello World'),
actionButton("button", "Some Button"),
bsTooltip("button", "Something to be said here", "top"),
)
)
server <- function(input, output) {
}
shinyApp(ui, server)
There are numerous posts regarding changing titles of other pieces of Shiny apps, e.g.:
Change the title by pressing a shiny button Shiny R
Shiny page title and image
Shiny App: How to dynamically change box title in server.R?
My question is related, but not answered by any of these. I would like to make the <head><title>...</title></head> tag reactive, or at least controllable from within an observeEvent in server.R.
The following does not work, since ui can't find theTitle, but is the kind of approach I'd hope is possible:
library(shiny)
ui <- fluidPage(
title = theTitle(),
textInput("pageTitle", "Enter text:")
)
server <- function(input, output, session) {
theTitle <- reactiveVal()
observeEvent( input$pageTitle, {
if(is.null(input$pageTitle)) {
theTitle("No title yet.")
} else {
theTitle(input$pageTitle)
}
})
}
I've tried making output$theTitle <- renderText({...}) with the if..else logic in that observeEvent, and then setting title = textOutput("theTitle") in ui's fluidPage, but that generates <div ...> as the title text, or <span ...> if we pass inline=True to renderText.
In case this clarifies what I'm looking for, the answer would make something equivalent to the literal (replacing string variables with that string) ui generated by
ui <- fluidPage(
title = "No title yet.",
....
)
before the user has entered any text in the box; if they have entered "Shiny is great!" into input$pageTitle's box, then we would get the literal
ui <- fluidPage(
title = "Shiny is great!",
....
)
One way would be to write some javascript to take care of that. For example
ui <- fluidPage(
title = "No title yet.",
textInput("pageTitle", "Enter text:"),
tags$script(HTML('Shiny.addCustomMessageHandler("changetitle", function(x) {document.title=x});'))
)
server <- function(input, output, session) {
observeEvent( input$pageTitle, {
title <- if(!is.null(input$pageTitle) && nchar(input$pageTitle)>0) {
input$pageTitle
} else {
"No title yet."
}
session$sendCustomMessage("changetitle", title)
})
}
shinyApp(ui, server)
This was created following the How to send messages from the browser to the server and back using Shiny guide
As of June 2021, there is an R package called shinytitle that can update the window title from within Shiny's reactive context: https://cran.r-project.org/package=shinytitle
I'm trying to add a tabPanel in navbarPage so that when you click on it opens a modal window instead of a new tab. The snippet below is not valid because tabPanel does not have an id parameter.
library(shiny)
library(shinyBS)
shinyUI(fluidPage(
navbarPage("Sample App", id = "main_menu",
tabPanel("Open Modal", id = "moda")),
bsModal("modal1", "Example", "moda", p("This is a modal"))
)
If I edit the generated HTML code from browser, I can make this possible by changing the line
Open Modal
with
Open Modal
on the <li> element.
Any idea how to do this or at least how can I override the generated html from shiny?
One solution is to use Javascript to rewrite the attribute for the tab title. The JS code below finds the tab title link, and rewrites its attributes.
library(shiny)
jsStr <- '$(document).ready(function(){
$("a[data-value=\'OpenModal\']").attr({
"href":"#",
"data-toggle":"modal",
"data-target":"#modal1"
});
})
'
ui <- shinyUI(fluidPage(
tags$head(tags$script(HTML(jsStr))),
navbarPage("title",
tabPanel("OpenModal")
),
bsModal("modal1", "Example", "moda", p("This is a modal"))
))
I have been working with shinyBS to create a set of collapsible panels. In the one shown below, only one panel should be open at a time (since the parameter multiple defaults to FALSE), but all three can be opened at the same time.
ui.R
library(shiny)
library(shinyBS)
shinyUI(fluidPage(
bsCollapse(
id = "stuff.all",
bsCollapsePanel(title = "Load Data", "Load the files"),
bsCollapsePanel(title = "Set Parameters", "Set the parameters"),
bsCollapsePanel(title = "Teacher Settings", "Choose the teachers")
)
))
server.R
library(shiny)
library(shinyBS)
shinyServer(function(input, output) {})
What is causing this bsCollapse to act as though multiple = TRUE, and how can I prevent it in the future?
Reference: https://ebailey78.github.io/shinyBS/docs/Collapses.html
I actually figured this out while writing the question, so I plan to answer my own question.
The id for bsCollapse in my example was "stuff.all". The fact that a period was part of the id seems to be what created the problem. When I changed the id to "stuff", the problem went away. When the id is "stuff.al" or "stuff.a", the problem persists. When the id is "stuff." or ".stuff", none of the panels expand when clicked. Given the way that bsCollapse works, the problem arises either from having a period in the id of an HTML <div> tag like so:
<div class="panel-group sbs-panel-group" data-sbs-multi="FALSE" id="stuff.a" role="tablist">
or from having a period in the data-toggle of an HTML <a> tag, like so:
<a data-toggle="collapse" href="#cpanel0758223" data-parent="#stuff.a">Load Data</a>
Is there a way to color fileInput button in R shiny? It looks like it is possible as shown here on this page on github. However I cannot find the code for this to be done.
This is the simple application that I would like to modify to have the button and progress bar colored red.
In ui.R:
library(shiny)
shinyUI(fluidPage(
titlePanel("Test"),
fileInput("Test","")
))
and server.R
library(shiny)
shinyServer(
function(input, output) {
}
)
Thanks for any advice.
You can use standard Bootstrap classes to style action buttons:
library(shiny)
shinyApp(
ui=shinyUI(bootstrapPage(
actionButton("infoButton", "Info", class="btn-info"),
actionButton("warningButton", "Warning", class="btn-warning"),
actionButton("successButton", "Success", class="btn-success"),
actionButton("dangerButton", "Danger", class="btn-danger"),
actionButton("defaultButton", "Default", class="btn-default"),
actionButton("primaryButton", "Primary", class="btn-primary")
)),
server=shinyServer(function(input, output, session){
})
)
Regarding file inputs as far as I know it is not possible without using CSS directly. Page you've linked is an opened pull-request and it doesn't look like it will be merged soon.
This answer provides a good description how to create fancy upload buttons with bootstrap. It should work just fine in Shiny as well.
CSS could be used in shiny to custom your fileInput widget !
Use the following code in order to color it in red.
NB - Any browser you're using to view the app should have developer tools that let you inspect elements and see styles applied to any element. You have to right click on the relevant element and choose inspect !
library(shiny)
ui <- fluidPage(
fileInput(inputId = "Test",label = ""),
tags$style("
.btn-file {
background-color:red;
border-color: red;
}
.progress-bar {
background-color: red;
}
")
)
server <- function(input, output) {
}
shinyApp(ui = ui, server = server)