R/table.R

In skranz/RDockerStudio: Simple Docker Container Managment Tool as RStudio Addin or Shiny App

html.table = function(df, id = paste0("table", sample.int(1e9,1)), sel.row=NULL, show.header=TRUE, header=colnames(df), row.names=FALSE, border=TRUE, bg.color =c("#dddddd","#ffffff"), sel.color='#ffdc98', font.size="100%", round.digits=8, signif.digits=8,col.tooltips=NULL, td.padding = "3px 5px 3px 5px", td.margin = "2px 4px 2px 4px", ...) {
  restore.point("html.table")
  n = NROW(df)

  #bg.color =c("#ededfe","#fcfcff")
  #F7F7F7
  row.bgcolor = rep(bg.color,length=n)

  if (!is.null(sel.row)) {
    #row.bgcolor[sel.row]='#ffdc98'
    #row.bgcolor[sel.row]='#00ff00'
    #row.bgcolor[sel.row]=sel.color
  }

  if (show.header) {
    colnames=header
    if (is.null(col.tooltips)) {
      inner = colnames
    } else {
      inner = paste0('<span title="', col.tooltips,'">', colnames, '<span>')
      #inner[nchar(col.tooltips)==0] = colnames
    }

    head = paste0('<th class="data-frame-th">',inner,'</th>', collapse="")
    head = paste0('<tr>', head, '</tr>')
  } else {
    head = ""
  }


  td.class = rep("data-frame-td td-not-bottom", NROW(df))
  if (length(td.class)>0) {
    td.class[length(td.class)]="data-frame-td td-bottom"
  }
  #td.class = paste0(td.class," td-row-",1:NROW(df))
  tr.class = paste0("tr-row-", 1:NROW(df))
  if (length(sel.row)>0)
    tr.class[sel.row] = paste0("tr-sel-row")

  cols = 1:NCOL(df)
  rows = 1:NROW(df)
  code = paste0('"<td data-row = \\"",rows,"\\" data-col = \\"',cols,'\\" class=\\"",td.class,"\\" nowrap>", (df[[',cols,']]),"</td>"', collapse=",")
  code = paste0('paste0("<tr class=\\"",tr.class,"\\" style =\\"background-color:",row.bgcolor,";\\">",',code,',"</tr>", collapse="\\n")')
  call = parse(text=code)
  main = eval(parse(text=code))

  tab = paste0('<table class="data-frame-table" id="',id,'">\n', head, main, "\n</table>")

  th.style='font-weight: bold; margin: 5px; padding: 5px; border: solid 1px black; text-align: center;'
  td.style= paste0('font-family: Verdana,Geneva,sans-serif;  margin: ', td.margin, '; padding: ', td.padding,'; border: solid 1px black; text-align: left;')

  if (!is.null(font.size)) {
    th.style = paste0(th.style, "font-size: ", font.size,";")
    td.style = paste0(td.style, "font-size: ", font.size,";")

  }

  table.sel = paste0("#",id)
  tab = paste0("<style>",
               " ", table.sel," {	border-collapse: collapse;  display: block; overflow-x: auto;}\n",
               " ", table.sel, " td.data-frame-td {", td.style,"}\n",
               " ", table.sel, " tr.tr-sel-row { background-color:", sel.color," !important;}\n",
               " ", table.sel, " td-bottom {border-bottom: solid 1px black;}\n",
               " ", table.sel, " th.data-frame-th {", th.style,"}\n",
               " ", table.sel, " tbody>tr:last-child>td {
               border-bottom: solid 1px black;
}\n",
    "</style>",
    tab
  )

  #writeLines(tab, "test.html")
  tab

  return(tab)
}


#' Handler for a click on a table row
#' @param id id of the HTML img object
#' @param fun the handler fun that will be called when the image is clicked
#' @param ... additional arguments passed to the handler fun
tdClickHandler = function(id=NULL, fun, ..., eventId=if(stop.propagation) "tdClickEvent" else "tdClickEventWithPropagation", css.selector=paste0("#",id, " td.data-frame-td"), app=getApp(),no.authentication.required=FALSE, stop.propagation=TRUE, auto.select = FALSE, remove.sel.row.selector=NULL) {
  restore.point("tdClickHandler")

  sp = if (stop.propagation) "e.stopPropagation();" else ""
  inner.js = paste0('
                    var table = $(this).closest("table");
                    var td = $(this);
                    ',sp)
  if (auto.select) {
    if (is.null(remove.sel.row.selector)) {
      remove.sel = 'table.find("tr").removeClass("tr-sel-row");'
    } else {
      remove.sel = paste0('$("',remove.sel.row.selector,'").removeClass("tr-sel-row");')
    }
    inner.js = paste0(inner.js,'
      var tr = $(this).closest("tr");
      ',remove.sel,'
      tr.addClass("tr-sel-row");
    ')
  }

  shiny.value.code = paste0('{eventId: "',eventId,'", id: table.attr("id"), tdClass: td.attr("class"), data: td.data(), tdId: td.attr("id"),  tableId: table.attr("id"), tableClass: table.attr("class"), nonce: Math.random()}')

  customEventHandler(eventId = eventId,css.locator = css.selector,event = "click",id = id,inner.js.code = inner.js, shiny.value.code = shiny.value.code, fun=fun,...)
}