## ----include = FALSE---------------------------------------------------------- knitr::opts_chunk$set(collapse = TRUE, comment = "#>", eval = FALSE) ## ----------------------------------------------------------------------------- # # the smallest useful app, reproduced in full below # shiny::runApp(system.file("examples/minimal", package = "VanillaCalendar")) # # # a tour of everything else on this page # shiny::runApp(system.file("examples/gallery", package = "VanillaCalendar")) ## ----------------------------------------------------------------------------- # library(shiny) # library(VanillaCalendar) # # ui <- fluidPage( # titlePanel("Pick a date"), # VanillaCalendarOutput("cal", height = "400px"), # textOutput("chosen") # ) # # server <- function(input, output) { # output$cal <- renderVanillaCalendar(VanillaCalendar()) # output$chosen <- renderText({ # if (length(input$cal_selected) == 0) "Nothing picked yet." # else format(input$cal_selected, "%A, %d %B %Y") # }) # } # # shinyApp(ui, server) ## ----------------------------------------------------------------------------- # # let the user drag out a range # output$cal <- renderVanillaCalendar( # VanillaCalendar(list(selectionDatesMode = "multiple-ranged")) # ) # # # or make it a text box with a popup, for a form # output$cal <- renderVanillaCalendar( # VanillaCalendar(list(inputMode = TRUE), height = "auto") # ) # # # or add a time picker under the dates # output$cal <- renderVanillaCalendar( # VanillaCalendar(list(selectionTimeMode = 24), height = "440px") # ) ## ----------------------------------------------------------------------------- # output$summary <- renderText({ # dates <- input$cal_selected # if (length(dates) == 0) return("Nothing selected.") # paste(length(dates), "date(s), the first being", format(min(dates))) # }) ## ----------------------------------------------------------------------------- # VanillaCalendarOutput("when", height = "auto") # # output$when <- renderVanillaCalendar( # VanillaCalendar(list(inputMode = TRUE, selectionDatesMode = "single"), # height = "auto") # ) ## ----------------------------------------------------------------------------- # observeEvent(input$theme, { # vcSet(VanillaCalendarProxy("cal"), list(selectedTheme = input$theme)) # }) ## ----------------------------------------------------------------------------- # proxy <- VanillaCalendarProxy("cal") # # vcSet(proxy, list(dateMin = input$start)) # apply new options # vcUpdate(proxy) # re-render with current options # vcShow(proxy) # show a popup calendar # vcHide(proxy) # hide it again # vcDestroy(proxy) # remove it entirely ## ----------------------------------------------------------------------------- # # change the minimum date and drop the selection that no longer fits it # vcSet(proxy, list(dateMin = Sys.Date()), reset = list(dates = TRUE)) ## ----------------------------------------------------------------------------- # calendarServer <- function(id) { # moduleServer(id, function(input, output, session) { # output$cal <- renderVanillaCalendar(VanillaCalendar()) # observeEvent(input$go, vcHide(VanillaCalendarProxy("cal"))) # }) # } ## ----------------------------------------------------------------------------- # server <- function(input, output, session) { # output$start <- renderVanillaCalendar( # VanillaCalendar(list(inputMode = TRUE), height = "auto") # ) # output$end <- renderVanillaCalendar( # VanillaCalendar(list(inputMode = TRUE), height = "auto") # ) # # observeEvent(input$start_selected, { # vcSet(VanillaCalendarProxy("end"), list(dateMin = input$start_selected)) # }) # } ## ----------------------------------------------------------------------------- # VanillaCalendar(list( # selectionDatesMode = "multiple", # onClickDate = htmlwidgets::JS( # "function(self) { console.log(self.context.selectedDates); }" # ), # onCreateDateEls = htmlwidgets::JS( # "function(self, dateEl) { dateEl.title = 'Custom tooltip'; }" # ) # )) ## ----------------------------------------------------------------------------- # VanillaCalendar(list( # selectedTheme = "system", # themeAttrDetect = "html[data-bs-theme]" # ))