Есть ли блестящий виджет textInput со встроенной кнопкой «сброс»? - PullRequest
Новая
       10

Есть ли блестящий виджет textInput со встроенной кнопкой «сброс»?

1 голос
/ 04 марта 2020

Я разработал блестящее онлайн-приложение, которое содержит виджет textInput() для ввода имени местоположения и, соответственно, перенаправления пользователя на это местоположение на карте (используя функции API Google через пакет geocode).

Я хотел бы заменить свой текущий виджет textInput() на другой, в который встроена кнопка «X», чтобы автоматически удалять текст, вставленный пользователем. Пожалуйста, проверьте это изображение , чтобы увидеть пример этого (кнопка «X» отмечена красным).

Знаете ли вы, что можно сделать внутри блестящего приложения? Большое спасибо.

1 Ответ

2 голосов
/ 05 марта 2020

Попробуйте это: 

library(shiny)

clearableTextInput <- function(inputId, label, value = ""){
  el <- tags$div(
    tags$label(label, `for` = inputId),
    tags$span(
      class = "text-input-clearable",
      tags$input(id = inputId, type = "text", value = value),
      tags$span(title = "Clear", HTML("&times;"))
    )
  )
  js <- sprintf('
  var textInput = document.getElementById("%s");
  var clearBtn = textInput.nextElementSibling;
  textInput.onkeyup = function() {
    clearBtn.style.visibility = (this.value.length) ? "visible" : "hidden";
  };
  clearBtn.onclick = function() {
    this.style.visibility = "hidden";
    textInput.value = "";
    Shiny.setInputValue("%s", "");
  };
  ', inputId, inputId)
  tagList(el, singleton(tags$script(HTML(js))))
}

CSS <- "
.text-input-clearable {
  border:1px solid;
  padding:1px 6px 1px 1px;
  display:inline-block;
}
.text-input-clearable input {
  border:none;
  background:none;
  outline:none;
  padding:0 0;
  margin:0 0;
  font:inherit;
}
.text-input-clearable span {
  cursor:pointer;
  color:blue;
  font-weight:bold;
  visibility:hidden;
}
"

ui <- fluidPage(
  tags$head(
    tags$style(HTML(CSS))
  ),
  br(),
  clearableTextInput("txt", "Label"),
  br(),
  verbatimTextOutput("txt")
)

server <- function(input, output, session){

  output[["txt"]] <- renderPrint({
    input[["txt"]]
  })

}

shinyApp(ui, server)
...