Change cell background of rHandsontable with afterChange event on client side

Question

I'd like to change the background color of a handsontable cell after it's been edited by the user on the client side. The handsontable is defined through a Shiny application; so this is really a question about how to define event hooks in rHandsontable in the Shiny application. The general use case that I'm trying to accomplish is: users edit cell data; the background color change to indicate that it's been changed and is pending saving to a database; the change is passed back to Shiny's observeEvent(); the change is sent to an external database and saved; the the rHandsontable is redrawn on the output with default background coloring that removes the color set be the change. The result is the flicker indicates that data has been saved. And if there's a database connection error or other issue, the color will persist, indicating the data is unsaved. I've been able to accomplish a working example, pasted below.

Specific question: the hook is currently implemented using hot_col(1,renderer=change_hook) however, this isn't about rendering the cell, just a way that allows adding the hook. I assume hot_table() is the correct function, but can it be used to register events? More generally, is there a more built-in way of accomplishing this?

change_hook <- "
  function(instance, td, row, col, prop, value, cellProperties) {
Handsontable.hooks.add('afterChange', function(changes,source) { 
  if (source === 'edit' || source === 'undo' || source === 'autofill' || source === 'paste') {
    row = changes[0][0];
    col = changes[0][1];
    oldval = changes[0][2];
    newval = changes[0][3];

    if (oldval !== newval) {
      cell = this.getCell(row,col);
      cell.style.background = 'pink';
    }
  }
},instance);
Handsontable.renderers.TextRenderer.apply(this, arguments);
}"

ui <- div(width=300,rHandsontableOutput(outputId="hTable"))
server <- function(input, output, session) {

df<-data.frame(col1=c("Hands","on","Table"),col2=c(100,200,300),stringsAsFactors = F)
hTable <- reactiveVal(df)

observeEvent(input$hTable, {
withProgress(message = "Saving changes to database...", value=0.5, {

  Sys.sleep(1)

  incProgress(1, detail = "done")    
  input_hTable <- hot_to_r(input$hTable)
  hTable(input_hTable)
})
})

output$hTable <- renderRHandsontable({
rhandsontable(hTable(),stretchH="all",height=300) %>%
  hot_col(1,renderer=change_hook)
})
}
shinyApp(ui, server)

Answer 1

After searching for a while, I have used the info from these pages (handsontable, htmlwidgets) to change the background color of an edited cell.

In the afterChange function, list of all changed cells will be kept. In the afterRender function the background color of those cells will be changed to yellow. In the afterLoadData function, the background color of changed cells will be reset to white and it will be emptied.

library(shiny)
library(rhandsontable)

change_hook <- "function(el,x) {
var hot = this.hot;  
var cellChanges = [];

var changefn = function(changes,source) { 
if (source === 'edit' || source === 'undo' || source === 'autofill' || source === 'paste') {
row = changes[0][0];
col = changes[0][1];
oldval = changes[0][2];
newval = changes[0][3];

if (oldval !== newval) {
  var cell = hot.getCell(row, col);
  cell.style.background = 'pink';
  cellChanges.push({'rowid':row, 'colid':col});
}
}
}

var renderfn = function(isForced) {

for(i = 0; i < cellChanges.length; i++)
{

var rowIndex = cellChanges[i]['rowid'];
var columnIndex = cellChanges[i]['colid'];

var cell = hot.getCell(rowIndex, columnIndex);
cell.style.background = 'yellow';

}


}

var loadfn = function(initialLoad) {

for(i = 0; i < cellChanges.length; i++)
    {
      var rowIndex = cellChanges[i]['rowid'];
      var columnIndex = cellChanges[i]['colid'];

      var cell = hot.getCell(rowIndex, columnIndex);

      cell.style.background = 'white';

    }
cellChanges = []

}


hot.addHook('afterChange', changefn);
hot.addHook('afterRender', renderfn);
hot.addHook('afterLoadData', loadfn);


}  "


ui <- div(actionButton(inputId = "reset_button",label = "Reset")
          ,rHandsontableOutput(outputId="hTable"))


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

  df<-data.frame(col1=c("Hands","on","Table"),col2=c(100,200,300),stringsAsFactors = F)
  reset <- reactiveVal(0)
  hTable <- reactiveVal(df)

  output$hTable <- renderRHandsontable({
    r = reset()
    rht = rhandsontable(hTable(),reset=r,stretchH="all",height=300)%>%
      hot_col('col1',readOnly=T)
    reset(0)
    htmlwidgets::onRender(rht,change_hook)
  })

  observeEvent(input$reset_button,
               {
                 reset(1)
               })
}

shinyApp(ui, server)