在shiny R中自动调整文本输入框的大小

Question

我想要将这个SO答案关于如何通过JavaScript自动调整文本区域输入大小的方法应用到闪亮的R中。理想情况下，我想避免使用诸如shinyJS之类的辅助包。

首先，我尝试了一个纯JavaScript实现，在其中将JavaScript加载到应用程序中（方法1）。然后，我尝试从shiny的observeEvent中触发JavaScript函数（方法2）。

两种方法都不起作用。看来我漏掉了一些东西。

方法1：

library(shiny)

jsCode1 <- "
            var observe;
            if (window.attachEvent) {
            observe = function (element, event, handler) {
            element.attachEvent('on'+event, handler);
            };
            }
            else {
            observe = function (element, event, handler) {
            element.addEventListener(event, handler, false);
            };
            }
            function init () {
            var text = document.getElementById('text');
            function resize () {
            text.style.height = 'auto';
            text.style.height = text.scrollHeight+'px';
            }
            /* 0-timeout to get the already changed text */
            function delayedResize () {
            window.setTimeout(resize, 0);
            }
            observe(text, 'change',  resize);
            observe(text, 'cut',     delayedResize);
            observe(text, 'paste',   delayedResize);
            observe(text, 'drop',    delayedResize);
            observe(text, 'keydown', delayedResize);

            text.focus();
            text.select();
            resize();
            }

            init();
            "

shinyApp(ui = 

           fluidPage(

                        tags$script(jsCode1),

                        tags$head(

                          tags$style("
                                     textarea {
                                     border: 0 none white;
                                     overflow: hidden;
                                     padding: 0;
                                     outline: none;
                                     background-color: #D0D0D0;
                                     }
                                     "
                          )

                          ),

                               shiny::tagAppendAttributes(
                                 textAreaInput(inputId = "text",
                                               label = "Enter text here",
                                               placeholder = "insert your text here",
                                               width = "100%"),
                                 style = "width: 100%;")

                        ),

         server = function(input, output, session) {

         }
                      )

方法2：

library(shiny)

jsCode2 <- "

            Shiny.addCustomMessageHandler('handler1', init);

            function init (el) {
            var text = document.getElementById(el);
            function resize () {
            text.style.height = 'auto';
            text.style.height = text.scrollHeight+'px';
            }
            /* 0-timeout to get the already changed text */
            function delayedResize () {
            window.setTimeout(resize, 0);
            }
            observe(text, 'change',  resize);
            observe(text, 'cut',     delayedResize);
            observe(text, 'paste',   delayedResize);
            observe(text, 'drop',    delayedResize);
            observe(text, 'keydown', delayedResize);

            text.focus();
            text.select();
            resize();
            }"

shinyApp(ui = 

           fluidPage(

                        tags$script(jsCode2),

                        tags$head(

                          tags$style("
                                     textarea {
                                     border: 0 none white;
                                     overflow: hidden;
                                     padding: 0;
                                     outline: none;
                                     background-color: #D0D0D0;
                                     }
                                     "
                          )

                          ),

                               shiny::tagAppendAttributes(
                                 textAreaInput(inputId = "text",
                                               label = "Enter text here",
                                               placeholder = "insert your text here",
                                               width = "100%"),
                                 style = "width: 100%;")

                        ),

         server = function(input, output, session) {

           observeEvent(input$text,{

             session$sendCustomMessage("handler1", message = "text")

           })

         }
                      )

- TimTeaFan

Answer 1

可能是因为您在textinput()添加到DOM之前就尝试将调整大小事件附加到它上面了。

我添加了一个事件监听器，等待DOM加载完成后再附加调整大小事件。

document.addEventListener('DOMContentLoaded', function(event) {...})

shinyjs会自动为您完成这项任务。通过添加上面的事件监听器，您可以在不使用shinyjs的情况下使其正常工作。

Javascript 代码：

jsCode <- "document.addEventListener('DOMContentLoaded', function(event) {
    var observe;
    if (window.attachEvent) {
      observe = function (element, event, handler) {
        element.attachEvent('on'+event, handler);
      };
    }
    else {
      observe = function (element, event, handler) {
        element.addEventListener(event, handler, false);
      };
    }
    function init () {
      var text = document.getElementById('text');
      function resize () {
        text.style.height = 'auto';
        text.style.height = text.scrollHeight+'px';
      }
      /* 0-timeout to get the already changed text */
        function delayedResize () {
          window.setTimeout(resize, 0);
        }
      observe(text, 'change',  resize);
      observe(text, 'cut',     delayedResize);
      observe(text, 'paste',   delayedResize);
      observe(text, 'drop',    delayedResize);
      observe(text, 'keydown', delayedResize);

      text.focus();
      text.select();
      resize();
    };init()
  })
"

这个应用程序：

library(shiny)

ui <- fluidPage(
  shiny::tags$script(jsCode),
  textAreaInput(inputId = "text", label = "a", value = "b")
)

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

shinyApp(ui, server)

- Tonio Liebrand

---

谢谢+1，但你有没有想过为什么当textAreaInput在服务器端使用renderUI生成时，它不再起作用了？这样做是否会修改输出的ID，使其不能像js一样简单地访问text？ - Antoine

这可能是因为 JavaScript 代码在输入生成之前运行。你可以尝试利用 onFlushed 函数：https://shiny.rstudio.com/reference/shiny/latest/onflush。我没有尝试过，但类似于 "session $ onFlushed（shiny :: tags $ script（jsCode），....）"。如果这样不起作用，请随时添加一个问题并在此处链接。 - Tonio Liebrand

感谢您回复我。我会尝试您建议的方法，并在此处发布，如果我必须创建一个新问题。 - Antoine

Answer 2

有点晚了，但是这个方法对我来说很有效，可以在输入时动态地垂直扩展文本区域。

library(shiny)

ui <- fluidPage(
  tags$head(
    tags$style(
      HTML("
        textArea {
          overflow: hidden;
          resize: none;
        }
      ")
    ),
    tags$script(
      HTML('
        $(document).on("input", "#text", function() {
          this.style.height = "auto";
          this.style.height = (this.scrollHeight) + "px";
        });
      ')
    )
  ),
  textAreaInput("text", "", placeholder = "Enter your text", rows = 1, width = "200px")
)

server <- function(input, output, session) {
  observeEvent(input$text,
               print(input$text)
            )
}

shinyApp(ui, server)

- eh21