Merge pull request #72 from nathancday/key_bindings

Add keyboard shortcuts

Author: lionel-

NEWS.md

@@ -1,6 +1,13 @@
 
 # vdiffr 0.3.1.9000
 
+- Keyboard short cuts for common interactions:
+    Right/Left arrows = Next/Previous case
+    Down/Up arrows = Next/Previous type
+    ENTER = Validate active case
+    shift + ENTER = Validate active group
+    ESC = Quit app
+
 # vdiffr 0.3.1
 
 This release makes vdiffr compatible with ggplot2 3.2.0. It also

R/cases.R

@@ -140,6 +140,8 @@ delete_orphaned_cases <- function(cases = collect_orphaned_cases()) {
   walk(paths, file.remove)
 }
 
+# It is brittle to keep `pkg_path` in attributes. Maybe change to an
+# R6 object?
 cases <- function(x, pkg_path, deps = NULL) {
   structure(x,
     class = "cases",

R/shiny-server.R

@@ -3,6 +3,7 @@ vdiffrServer <- function(cases) {
   shiny::shinyServer(function(input, output, session) {
     cases <- shiny::reactiveValues(all = cases)
     cases$active <- shiny::reactive({
+      stopifnot(is_string(attr(cases$all, "pkg_path")))
       type <- input$type %||% "new_case"
       filter_cases(cases$all, type)
     })
@@ -30,6 +31,7 @@ vdiffrServer <- function(cases) {
     output$case_context <- renderCaseContext(input, cases)
 
     toggleValidateBtns(input, session)
+    listenToKeys(input, session, cases)
 
     quitApp(input)
   })
@@ -152,34 +154,33 @@ withdraw_cases <- function(cases) {
 }
 
 validateSingleCase <- function(input, reactive_cases) {
-  shiny::observe({
-    if (input$case_validation_button > 0) {
-      cases <- shiny::isolate(reactive_cases$all)
-      case <- shiny::isolate(input$case)
+  shiny::observeEvent(c(input$case_validation_button, input[["validateCase"]]), {
 
-      withdraw_cases(cases[case])
-      cases[[case]] <- success_case(cases[[case]])
+    cases <- shiny::isolate(reactive_cases$all)
+    case <- shiny::isolate(input$case)
+    shiny::req(input$case)
 
-      shiny::isolate(reactive_cases$all <- cases)
-    }
+    withdraw_cases(cases[case])
+    cases[[case]] <- success_case(cases[[case]])
+
+    shiny::isolate(reactive_cases$all <- cases)
   })
 }
 
-validateGroupCases <- function(input, reactive_cases) {
-  shiny::observe({
-    if (input$group_validation_button > 0) {
-      active_cases <- shiny::isolate(reactive_cases$active())
-      cases <- shiny::isolate(reactive_cases$all)
+validateGroupCases <- function(input, reactive_cases, session) {
+  shiny::observeEvent(c(input$group_validation_button, input[["validateGroup"]]), {
+    active_cases <- shiny::isolate(reactive_cases$active())
+    cases <- shiny::isolate(reactive_cases$all)
 
-      if (length(cases) > 0) {
-        type <- shiny::isolate(input$type)
+    if (length(cases) > 0) {
+      shiny::req(input$type)
+      type <- shiny::isolate(input$type)
 
-        withdraw_cases(active_cases)
-        idx <- sapply(cases, inherits, type)
-        cases[idx] <- lapply(cases[idx], success_case)
+      withdraw_cases(active_cases)
+      idx <- purrr::map_lgl(cases, inherits, type)
+      cases <- purrr::modify_if(cases, idx, success_case)
 
-        shiny::isolate(reactive_cases$all <- cases)
-      }
+      shiny::isolate(reactive_cases$all <- cases)
     }
   })
 }
@@ -230,6 +231,33 @@ toggleValidateBtns <- function(input, session) {
   })
 }
 
+listenToKeys <- function(input, session, reactive_cases) {
+  shiny::observeEvent(input[["nextCase"]], {
+    names <- unique(names(reactive_cases$active()))
+    shiny::updateSelectInput(session, "case",
+      selected = next_element(input$case, names)
+    )
+  })
+  shiny::observeEvent(input[["prevCase"]], {
+    names <- unique(names(reactive_cases$active()))
+    shiny::updateSelectInput(session, "case",
+      selected = next_element(input$case, names, direction = -1)
+    )
+  })
+  shiny::observeEvent(input[["nextType"]], {
+    types <- unique(map_chr(reactive_cases$all, function(case) class(case)[[1]]))
+    shiny::updateSelectInput(session, "type",
+      selected = next_element(input$type, types)
+    )
+  })
+  shiny::observeEvent(input[["prevType"]], {
+    types <- unique(map_chr(reactive_cases$all, function(case) class(case)[[1]]))
+    shiny::updateSelectInput(session, "type",
+      selected = next_element(input$type, types, direction = -1)
+    )
+  })
+}
+
 quitApp <- function(input) {
   shiny::observe({
     if (input$quit_button > 0) {

R/utils.R

@@ -187,3 +187,19 @@ is_ci <- function() {
 is_bool <- function(x) {
   is_logical(x, n = 1) && !is.na(x)
 }
+
+next_element <- function(element, group, direction = 1) {
+  if (element == "") {
+    return(NULL) # if a type is empty
+  }
+
+  next_position <- match(element, group) + direction
+
+  if (next_position > length(group)) {
+    next_position <- next_position - length(group)
+  } else if (next_position < 1) {
+    next_position <- length(group)
+  }
+
+  group[next_position]
+}

inst/www/toggle.js

@@ -13,4 +13,27 @@ Shiny.addCustomMessageHandler('toggle-validate-btns-handler', toggleBtns);
 function toggleBtns(message) {
   document.getElementById('group_validation_button').disabled = message;
   document.getElementById('case_validation_button').disabled = message;
-}
+}
+
+//Keyboard shortcuts
+document.onkeydown = function(e) {
+  if (e.shiftKey) { // using e.shiftKey && e.which == 86 simultaneously doesn't work?
+    if (e.which == 13) { // ENTER
+      Shiny.onInputChange("validateGroup", Math.random());
+    }
+  } else {
+     if (e.which == 39) { // right-arrow
+      Shiny.onInputChange("nextCase", Math.random());
+     } else if (e.which == 37) { // left-arrow
+      Shiny.onInputChange("prevCase", Math.random());
+     } else if (e.which == 40) { // down-arrow
+      Shiny.onInputChange("nextType", Math.random());
+     } else if (e.which == 38) { //up-arrow
+      Shiny.onInputChange("prevType", Math.random());
+     } else if (e.which == 13) { // ENTER
+      Shiny.onInputChange("validateCase", Math.random());
+    } else if (e.which == 27) { //esc, q = 81
+      Shiny.onInputChange("quit_button", Math.random());
+    }
+  }
+};