Change the font and its size in a Tcltk GUI - r

How can I change the default font and its size from a menu in a GUI I'm creating using Tcltk? The example below has only one menu called 'File', but in my GUI, It will have more than that. So all of them have to be re-sized. Is there any way to do that for my entire GUI?
Thank you in advance!
require(tcltk)
readCsv <- function(){
myval <- tkgetOpenFile()
mydata <- read.csv(paste(as.character(myval), collapse = " "))
assign("myData", mydata, envir = .GlobalEnv)
}
tt <- tktoplevel()
topMenu <- tkmenu(tt)
tkconfigure(tt, menu = topMenu)
fileMenu <- tkmenu(topMenu, tearoff = FALSE)
tkadd(fileMenu, "command", label = "Quit", command = function() tkdestroy(tt))
tkadd(fileMenu, "command", label = "Load", command = function() readCsv())
tkadd(topMenu, "cascade", label = "File", menu = fileMenu)
tkfocus(tt)

The default font for menus is a named font; TkMenuFont on most platforms (and menu on OSX, where you really shouldn't change it). This is usually mapped to the correct system default font for menus. However, if you do want to change it, you're still recommended to use a named font (which is what is used in a font object in R TclTk) following the pattern on this page except that you're applying the font to a menu widget instead of a label.
# Example to show how to do it
fontMenu <- tkfont.create(family="times",size=24,weight="bold",slant="italic")
fileMenu <- tkmenu(topMenu, tearoff = FALSE, font = fontMenu)
The only platform where you shouldn't do this at all is OSX, where menus work rather differently (except at the script level; there's a lot of differences being hidden under the covers!)

Yes, using the option database.
See this question for an example showing the option database for use with a button, but works the same for menus:
https://stackoverflow.com/questions/20960107/is-there-a-way-to-have-a-global-style-for-button-in-tcl

Related

Shiny Title image seems unformatted

I was working on a Shiny application, and instead of a title, I wanted to use an image. While the code did not raise any errors and shows the designated area for the image, the image doesn't show up.
Here is the code:
# header UI
ui <- navbarPage(title = div(img(src="/Users/atillacolak/Desktop/tafn_logo.png",
height = 60,
style = "margin-top: -14px; padding-right:10px;padding-bottom:10px")),
selected = "home",
theme = bs_theme(
bg = "white",
fg = "#ed7117",
base_font = font_google("Prompt"),
code_font = font_google("JetBrains Mono")),
fluid = TRUE,
home)
The result of this code is given in the image below.
As you can see the image does not format. What is the problem here?
You need to make the image available as a static resource to shiny's webserver.
Either you put the image in a www folder (subdirctory of your app folder) and set src = "/tafn_logo.png" or you use addResourcePath:
addResourcePath(prefix = "Desktop", directoryPath = "/Users/atillacolak/Desktop")
src using prefix:
img(src="Desktop/tafn_logo.png",
height = 60,
style = "margin-top: -14px; padding-right:10px;padding-bottom:10px")
See my related answer here.

Why are the icons not displaying in a DT::datatable in Shiny app?

I'm having some trouble displaying icons with sparklines within a DT::datatable column in a Shiny app even though I have escaped the HTML.
Edit: Removed 2nd question.
library(shiny)
library(dplyr)
ui <- fluidPage(
htmlwidgets::getDependency('sparkline'),
DT::dataTableOutput("table")
)
server <- function(input, output) {
raw_data <- data.frame(date = 2000:2021,
value = sample(100:500, 22),
icon = as.character(icon("arrow-up")))
data <- raw_data %>%
group_by(icon) %>%
# Create the sparkline
summarise("value" = sparkline::spk_chr(c(value),
xvalues = date,
tooltipFormat = '{{x}}: {{y}}'))
output$table <- DT::renderDataTable({
cb <- htmlwidgets::JS('function(){debugger;HTMLWidgets.staticRender();}')
DT::datatable(data = data,
escape = FALSE,
options = list(drawCallback = cb))
})
}
shinyApp(ui, server)
By default, the shiny::icon function:
generates the HTML code corresponding to the icon;
generates a script tag which includes the font-awesome icon library.
When you do as.character(icon(......, you only get the HTML code. The font-awesome library is not loaded, that's why the icon does not display.
The simplest way to get the icon is to use the glyphicon icon library, which is included in bootstrap so there's nothing to load (since bootstrap is loaded in Shiny apps):
as.character(icon("arrow-up", lib = "glyphicon"))
If you really want a font-awesome icon, there are two possibilities:
include the font-awesome library with a link tag;
or use the icon function elsewhere in your app, without as.character (you can hide it with the display:none CSS property if you don't want to see this icon) as shown below.
# add inside ui
tags$span(icon("tag"), style = "display: none;")

Remove check all/none checkbox from Reactable table

I want to remove the check all/none checkbox from a Reactable table.
In this image, I do not want the orange circled checkbox to appear.
Using Chrome Inspector, I examine the css of this checkbox and set display: none;
This removes the entire column of checkboxes. How do I remove just this one?
R Script
library(reactable)
reactable(iris,
onClick = "select",
selection = "multiple")
U can append some javascript code and make it run when the reactable is rendered:
ie
// Hide the select all check box
document.querySelector('.rt-select-input[aria-label="Select all rows"]').parentElement.parentElement.style.display = "none";
The final R-code
library(reactable)
library(htmlwidgets)
e<-reactable(iris,
onClick = "select",
selection = "multiple")
javascript <- JS('
document.querySelector(\'.rt-select-input[aria-label="Select all rows"]\').parentElement.parentElement.style.display="none";
')
(p <- prependContent(e,onStaticRenderComplete(javascript)))
Improvements
In order to streamline the process and specifically target the wanted checkbox (as the aforementioned method would be unsuccessful when handling 2 tables in the same page) I wrote a function that'll dynamically target the wanted checkbox:
hide.select.all <- function(x){
javascript <- JS(paste0('
let id = null;
for (const script of document.querySelectorAll("script[data-for]")) {
if(script.text.includes("', x$x$tag$attribs$dataKey ,'")) {
id="#" + script.dataset.for;
break;
}
}
if(id) document.querySelector(id + \' .rt-select-input[aria-label="Select all rows"]\').parentElement.parentElement.style.display="none";
'))
prependContent(x,onStaticRenderComplete(javascript))
}
hide.select.all(e)

R Shiny Dashboard - Custom Dropdown Menu In Header

From the shiny dashboard github, I've gathered that it's possible to create drop down menus at the top right of the header, but there are only 3 "types" (messages, notifications, and tasks).
https://rstudio.github.io/shinydashboard/structure.html#structure-overview
Is there a method for creating a custom dropdown? I'd like to make a settings dropdown, where I give the user some checkboxes that they can use to adjust the dashboard in ways (displaying/hiding things, filtering data, etc.)
I customized one of the three types of menu to allow this. You could then add actionItem(s) for items. tabSelect property when true simulate the selection of a sidebarMenuItem.
dropdownActionMenu <- function (..., title=NULL, icon = NULL, .list = NULL, header=NULL) {
items <- c(list(...), .list)
lapply(items, shinydashboard:::tagAssert, type = "li")
type <- "notifications" # TODO créer action + CSS
dropdownClass <- paste0("dropdown ", type, "-menu")
tags$li(class = dropdownClass, a(href = "#", class = "dropdown-toggle",
`data-toggle` = "dropdown", icon, title), tags$ul(class = "dropdown-menu",
if(!is.null(header)) tags$li(class="header",header),
tags$li(tags$ul(class = "menu", items))))
}
actionItem = function (inputId, text, icon = NULL, tabSelect=FALSE) {
if(!is.null(icon)) {
shinydashboard:::tagAssert(icon, type = "i")
icon <- tagAppendAttributes(icon, class = paste0("text-", "success"))
}
if(tabSelect) {
tags$li(a(onclick=paste0("shinyjs.tabSelect('",inputId,"')"),icon,text))
} else {
tags$li(actionLink(inputId,text,icon))
}
}
javascript function to select tab (to be inserted after useShinyjs() in body)
extendShinyjs(text="shinyjs.tabSelect=function(tabName){$('a[data-value='+tabName+']').click();}")
Sample code
dashboardHeader(
dropdownActionMenu(title="test",
actionItem("mnuFirst","First"),
actionItem("mnuSecond","Second")
)
)
Shiny Dashboard is based on admin LTE. So the existing type of drop downs are designed for admin LTE use case, which is quite different from many Shiny app usage.
If something is not even available in admin LTE, it's less likely to be supported in Shiny dashboard.
For your specific question, you can put some controls in the side bar. Another possibility is to use the wrench icon in box, which is not implemented in Shiny yet.

How to add icon in button using library(tcltk) in R?

I use the library (tcltk) in R to make the GUI. Code to create a button is :
tt <- tktoplevel()
button.widget <- tkbutton(tt, text = "", command = function())
I want the existing button on the GUI has an icon. How is the code to add the icon in the button using the library (tcltk) in R?
Use the tkimage.create function to create a Tcl-level representation of an image file. Note that there are some limitations on image formats and I believe GIF is the easiest to work with. Then, you specify the image as the image argument to tkbutton. Here's an example using, an Example.gif from Wikipedia:
library("tcltk")
img <- tclVar()
tclimg <- tkimage.create("photo", img, file = "Example.gif")
tt <- tktoplevel()
button.widget <- tkbutton(tt, text = "Click me!", image = tclimg, compound = "top",
command = function() tkmessageBox(message = "Hello!"))
tkgrid(button.widget)
You can control the relative placement of the image and text on the button using the compound argument:
"none" (display only the image if present, otherwise the text; the default)
"text" (text only)
"image" (image only)
"center" (text in center of image)
"top" (image above text)
"left" (image left of text)
"bottom" (image below text)
"right" (image right of text)

Resources