Adapted Jeff Allen's "Chat Room"

chatJava.js

// This script just listens for "enter"s on the text input and simulates
// clicking the "send" button when that occurs. Totally optional.
jQuery(document).ready(function(){
  jQuery('#entry').keypress(function(evt){
    if (evt.keyCode == 13){
      // Enter, simulate clicking send
      jQuery('#send').click();
    }
  });
})

// We don't yet have an API to know when an element is updated, so we'll poll
// and if we find the content has changed, we'll scroll down to show the new
// comments.
var oldContent = null;
window.setInterval(function() {
  var elem = document.getElementById('chat');
  if (oldContent != elem.innerHTML){
    scrollToBottom();
  }
  oldContent = elem.innerHTML;  
}, 300);

// Scroll to the bottom of the chat window.
function scrollToBottom(){
  var elem = document.getElementById('chat');
  elem.scrollTop = elem.scrollHeight;
}

// delay the reactive textInput component
// by Joe Cheng
// https://groups.google.com/forum/#!topic/shiny-discuss/lyewrRBVwWw
var slowTextInputBinding = new Shiny.InputBinding();
$.extend(slowTextInputBinding, {
  find: function(scope) {
    return $(scope).find('input[type=\"text\"]');
  },
  getId: function(el) {
    return Shiny.InputBinding.prototype.getId.call(this, el) || el.name;
  },
  getValue: function(el) {
    return el.value;
  },
  setValue: function(el, value) {
    el.value = value;
  },
  subscribe: function(el, callback) {
    $(el).on('keyup.textInputBinding input.textInputBinding', function(event) {
        callback(true);
  });
    $(el).on('change.textInputBinding', function(event) {
      callback(false);
    });
  },
  unsubscribe: function(el) {
    $(el).off('.textInputBinding');
  },
  getRatePolicy: function() {
    return {
      policy: 'debounce',
      delay: 10000
    };
  }
});
Shiny.inputBindings.register(slowTextInputBinding, 'entry');

chatStyles.css

#mainhead {
  width: 50%;
  display: block;
  float: left;
  margin-left: 1%;
  min-height: 30px;
  text-align: left;
  padding: 10px 0;
  font-size: 14px;
  line-height: 20px;
  color: rgb(51, 51, 51);
}

#righthead {
  width: 40%;
  display: block;
  float: right;
  margin-left: 0%;
  margin-right: 5%;
  min-height: 30px;
  text-align: right;
  padding: 10px 0;
  font-size: 14px;
  line-height: 20px;
  color: rgb(170, 170, 170);
}

#mainpane {
  width: 60%;
  display: block;
  float: left;
  margin-left: 0px;
  min-height: 30px;
  text-align: left;
  padding: 10px 0;
  font-size: 14px;
  line-height: 20px;
  color: rgb(51, 51, 51);
}

#rightpane {
  width: 33%;
  display: block;
  float: left;
  margin-left: 3%;
  min-height: 30px;
  text-align: left;
  padding: 10px 0;
  font-size: 14px;
  line-height: 20px;
  color: rgb(51, 51, 51);
}

#chat {
  padding: .5em;
  border: 1px solid #777;
  min-height: 200px;
  max-height: 400px;
  overflow: scroll;
}

.user-change, .user-exit, .user-enter {
  color: #aaa;
  font-size: .8em;
}

.username {
  font-weight: bold;
  color: #226;
}

#entry {
  width: 100%;
}

.center {
  text-align :center;
  padding-top: 3px;
}

html, body {
    height: 100%;
}

.fill { 
    min-height: 100%;
    height: 100%;
}

server.R

library("shiny")

# Globally define a place where all users can share some reactive data.
vars <- reactiveValues(chat = NULL, users = NULL)

# Restore the chat log from the last session.
if (file.exists("chats/chat.Rds")){
  vars$chat <- readRDS("chats/chat.Rds")
}

# Get the prefix for the line to be added to the chat window. 
# Usually a newline character unless it's the first line.
linePrefix <- function(){
  if (is.null(isolate(vars$chat))){
    return(paste0(Sys.time(), "  "))
  }
  return(paste0("<br />",Sys.time()," :  "))
}

shinyServer(function(input, output, session) {
  # Create a spot for reactive variables specific to this particular session
  sessionVars <- reactiveValues(username = "")
  
  # Track whether or not this session has been initialized. 
  # Assign a username to unininitialized sessions.
  init <- FALSE
  
  # When a session is ended, remove the user and note that they left the chat. 
  session$onSessionEnded(function() {
    isolate({
      vars$users <- vars$users[vars$users != sessionVars$username]
      vars$chat <- c(vars$chat, 
        paste0("<span class=\"user-exit\">", linePrefix(), 
          sanitize(sessionVars$username), " left the chat.</span>"))
    })
  })
  
  # Observer to handle changes to the username
  observe({
    # We want a reactive dependency on input$user
    input$user
    
    if (!init){
      # Seed initial username
      sessionVars$username <- paste0("Visitor ", round(runif(1, 10000, 99999)) )
      isolate({
        vars$chat <<- c(vars$chat, 
          paste0("<span class=\"user-enter\">", linePrefix(),
            sanitize(sessionVars$username), " entered the chat.</span>"))
      })
      init <<- TRUE
    } else {
      # A previous username was already given
      isolate({
        if (input$user == sessionVars$username || input$user == ""){
          # No change. Just return.
          return()
        }
        
        # Updating username      
        # First, remove the old one
        vars$users <- vars$users[vars$users != sessionVars$username]
        
        # Note the change in the chat log
        vars$chat <<- c(vars$chat, 
          paste0("<span class=\"user-change\">", linePrefix(),
            sanitize(sessionVars$username), " -> ", sanitize(input$user), "\"</span>"))
        
        # Now update with the new one
        sessionVars$username <- sanitize(input$user)
      })
    }
    # Add this user to the global list of users
    isolate(vars$users <- c(vars$users, sessionVars$username))
  })
  
  # Keep the username updated with whatever sanitized/assigned username we have
  observe({
    updateTextInput(session, "user", value=sessionVars$username)    
  })
  
  # Keep the list of connected users updated
  output$userList <- renderUI({
    tagList(tags$ul( lapply(vars$users, function(user){
      return(tags$li(user))
    })))
  })
  
  # Listen for input$send changes (i.e. when the button is clicked)
  observe({
    if(input$send < 1){
      # The code must be initializing, b/c the button hasn't been clicked yet.
      return()
    }
    isolate({
      # Add the current entry to the chat log.
      vars$chat <<- c(vars$chat, 
        paste0(linePrefix(), "<span class=\"username\">", "<abbr title=\"", 
          Sys.time(), "\">", sessionVars$username, "</abbr></span>: ", sanitize(input$entry)))
    })
    # Clear out the text entry field.
    updateTextInput(session, "entry", value="")
  })
  
  # Dynamically create the UI for the chat window.
  output$chat <- renderUI({
    if (length(vars$chat) > 500){
      # Too long, use only the most recent 500 lines
      vars$chat <- vars$chat[(length(vars$chat)-500):(length(vars$chat))]
    }
    # Save the chat object so we can restore it later if needed.
    saveRDS(vars$chat, "chats/chat.Rds")
    
    # Pass the chat log through as HTML
    HTML(vars$chat)
  })
})

# Replace any HTML tags in user-provided strings to prevent malicious entries.
sanitize <- function(string){
  str_replace_all(string, "[<>]", "")
}

ui.R

# ui.R

library("shiny")

chatPage <- function(css,js,tags,mainHeader,rightHeader,mainPanel,rightPanel) {
  bootstrapPage(css,js,tags,
    div(class = "container-fluid",
      div(class = "row-fluid",
        div(class = "span6", mainHeader, id = "mainhead"),
        div(class = "row-fluid", rightHeader, id = "righthead")
      ),
      div(class = "row-fluid", 
        div(class = "span8", mainPanel, id = "mainpane"),
        div(class = "span4", rightPanel, id = "rightpane")
      )
    )
  )
}

shinyUI(
  chatPage(
    # custom CSS styling
    css = includeCSS("www/chatStyles.css")
    ,
    # custom JavaScript
    js = includeScript("www/chatJava.js")
    , 
    # page title
    tags = tags$head(tags$title("LBA Chat"))
    , 
    # main header
    mainHeader = div(
      h2("Send us feedback!"),
      h4("Please be specific ... and polite.")
    )
    , 
    # right-side header
    rightHeader = div(
      h4("IP Addresses are logged.")
    )
    ,
    # main panel
    mainPanel = wellPanel(
      uiOutput("chat")
      , br(),
      fluidRow(# Create the bottom chat bar.
        div(class = "span10", textInput("entry", ""))
        ,
        div(class = "span2 center", actionButton("send", "Send"))
      )
    )
    ,
    # right-side panel
    rightPanel = wellPanel(
      # Let the user define his/her own ID
      textInput("user", "Optional: Your Student ID:", value=""),
      tags$hr(),
      h5("Connected Users"),
      # Create a spot for a dynamic UI containing the list of users.
      uiOutput("userList"),
      tags$hr()
      , helpText("Webmaster: Dr. Patrick Toche")
      , helpText(a("[email protected]"
            , href = "mailto:[email protected]?Subject=LBA Survey"
            , target = "_top"
      ) )
      , helpText(a("http://spark.rstudio.com/toche/usj-chat", href="http://spark.rstudio.com/toche/usj-chat", target="_blank"))
      , helpText("Original design Copyright (c) 2014 Jeff Allen.")
      , helpText(img(src = "RStudio.png", height = 32, width = 32), "Thanks to RStudio for making the server available free of charge.")
    )
  )
)

Very cool! It's great to see this being put to use.

FYI - I don't know if you had noticed or not, but I did have it setup to show the date/time when you hover over the username associated with a chat entry, but that is pretty subtle. Certainly could be desirable to just print it out inline.

@trestletech, Oh thanks, no I don't think I'd noticed, thanks for pointing it out!