tests/testthat/test-textarea.R

In termr: Modern Reactive Terminal Applications with Data Workflows

ta_app <- function(value = "", width = 30, height = 8, ...) {
  ed <- text_area(value, id = "ed", ...)
  a <- app(ed)
  list(app = a, ed = ed, pilot = test_app(a, width, height))
}

test_that("typing, Enter, Backspace and Delete edit the text", {
  t <- ta_app("")
  t$pilot$type("hello")
  t$pilot$press("enter")
  t$pilot$type("world")
  expect_identical(t$ed$value, "hello\nworld")
  expect_identical(c(t$ed$cursor_row, t$ed$cursor_column), c(2L, 6L))
  t$pilot$press("backspace")
  expect_identical(t$ed$value, "hello\nworl")
  t$pilot$press("home", "backspace")
  expect_identical(t$ed$value, "helloworl")
  t$pilot$press("left", "left", "delete")
  expect_identical(t$ed$value, "heloworl")
  t$pilot$press("ctrl+home", "delete")
  expect_identical(t$ed$value, "eloworl")
  t$pilot$press("ctrl+end")
  expect_identical(t$ed$cursor_column, 8L)
})

test_that("the text is drawn with a border, line numbers and wrapping", {
  t <- ta_app("alpha beta gamma delta\nshort", width = 18, height = 6, line_numbers = TRUE)
  text <- t$pilot$screen_text()
  expect_match(text[[2]], "^\u2502 *1 alpha beta")
  expect_true(any(grepl("^\u2502 +gamma delta", text)))
  expect_true(any(grepl("^\u2502 *2 short", text)))
  # Wrapped rows never exceed the content width.
  expect_true(all(nchar(text) == 18))
})

test_that("cursor movement follows visual rows and keeps its column", {
  t <- ta_app("abcdef\nab\nabcdefgh", width = 20, height = 6)
  t$pilot$press("end", "down")
  expect_identical(c(t$ed$cursor_row, t$ed$cursor_column), c(2L, 3L))
  t$pilot$press("down")
  expect_identical(c(t$ed$cursor_row, t$ed$cursor_column), c(3L, 7L))
  t$pilot$press("up", "up")
  expect_identical(c(t$ed$cursor_row, t$ed$cursor_column), c(1L, 7L))
  # Left at the start of a line goes to the end of the previous one.
  t$pilot$press("down", "home", "left")
  expect_identical(c(t$ed$cursor_row, t$ed$cursor_column), c(1L, 7L))
  t$pilot$press("right")
  expect_identical(c(t$ed$cursor_row, t$ed$cursor_column), c(2L, 1L))
  # Up on the first line goes to its start; down on the last to its end.
  t$pilot$press("ctrl+home", "up")
  expect_identical(t$ed$cursor_column, 1L)
  t$pilot$press("ctrl+end", "down")
  expect_identical(c(t$ed$cursor_row, t$ed$cursor_column), c(3L, 9L))
})

test_that("word movement and word deletion", {
  t <- ta_app("foo bar.baz\nqux", width = 30)
  t$pilot$press("ctrl+right")
  expect_identical(t$ed$cursor_column, 4L)
  t$pilot$press("ctrl+right")
  expect_identical(t$ed$cursor_column, 8L)
  t$pilot$press("ctrl+right")
  expect_identical(t$ed$cursor_column, 12L)
  t$pilot$press("ctrl+left")
  expect_identical(t$ed$cursor_column, 9L)
  t$pilot$press("ctrl+backspace")
  expect_identical(t$ed$value, "foo baz\nqux")
  t$pilot$press("ctrl+delete")
  expect_identical(t$ed$value, "foo \nqux")
})

test_that("selection by keyboard, replacement and deletion", {
  t <- ta_app("one two three", width = 30)
  t$pilot$press("shift+right", "shift+right", "shift+right")
  expect_identical(t$ed$selection, "one")
  t$pilot$type("1")
  expect_identical(t$ed$value, "1 two three")
  t$pilot$press("ctrl+a")
  expect_identical(t$ed$selection, "1 two three")
  t$pilot$press("backspace")
  expect_identical(t$ed$value, "")
  expect_true(t$ed$can_undo)
})

test_that("multi-line selection is highlighted including line breaks", {
  t <- ta_app("ab\ncd\nef", width = 12, height = 7)
  t$pilot$press("right", "shift+down", "shift+down")
  expect_identical(t$ed$selection, "b\ncd\ne")
  screen <- t$pilot$driver$terminal$screen
  # 'b' on row 1 is selected, the end of line 1 too, 'c' on row 2 as well.
  expect_identical(screen$get_cell(3, 2)$bg, "blue")
  expect_identical(screen$get_cell(2, 3)$bg, "blue")
  expect_identical(screen$get_cell(3, 4)$bg, "")
})

test_that("copy, cut and paste use the app clipboard and OSC 52", {
  t <- ta_app("alpha beta", width = 30)
  t$pilot$press("shift+right", "shift+right", "shift+right", "shift+right", "shift+right")
  t$pilot$press("ctrl+c")
  expect_identical(t$app$clipboard, "alpha")
  expect_identical(t$pilot$system_clipboard(), "alpha")
  t$pilot$press("end", "ctrl+v")
  expect_identical(t$ed$value, "alpha betaalpha")
  t$pilot$press("shift+left", "ctrl+x")
  expect_identical(t$app$clipboard, "a")
  expect_identical(t$ed$value, "alpha betaalph")
})

test_that("a bracketed paste keeps line breaks and is one undo step", {
  t <- ta_app("", width = 30)
  t$pilot$type("x")
  t$pilot$paste("l1\nl2\r\nl3\u001b[31m")
  expect_identical(t$ed$value, "xl1\nl2\nl3[31m")
  expect_identical(c(t$ed$cursor_row, t$ed$cursor_column), c(3L, 7L))
  t$pilot$press("ctrl+z")
  expect_identical(t$ed$value, "x")
  t$pilot$press("ctrl+y")
  expect_identical(t$ed$value, "xl1\nl2\nl3[31m")
  t$pilot$press("ctrl+z", "ctrl+z")
  expect_identical(t$ed$value, "")
})

test_that("undo groups typing by word and restores the cursor", {
  t <- ta_app("", width = 30)
  t$pilot$type("hello world")
  expect_identical(t$ed$value, "hello world")
  t$pilot$press("ctrl+z")
  expect_identical(t$ed$value, "hello ")
  expect_identical(t$ed$cursor_column, 7L)
  t$pilot$press("ctrl+z")
  expect_identical(t$ed$value, "")
  t$pilot$press("ctrl+z")
  expect_identical(t$ed$value, "")
  t$pilot$press("ctrl+y", "ctrl+y")
  expect_identical(t$ed$value, "hello world")
  # A cursor move closes the group.
  t$pilot$press("left")
  t$pilot$type("X")
  t$pilot$press("ctrl+z")
  expect_identical(t$ed$value, "hello world")
})

test_that("undo history is bounded", {
  t <- ta_app("", width = 30, max_history = 5)
  for (i in 1:20) t$pilot$paste(paste0("line", i, "\n"))
  expect_identical(t$ed$n_lines, 21L)
  for (i in 1:20) t$pilot$press("ctrl+z")
  expect_identical(t$ed$n_lines, 16L)
  expect_false(t$ed$can_undo)
})

test_that("Enter keeps indentation with auto_indent and Tab indents on request", {
  t <- ta_app("  indented", width = 30, auto_indent = TRUE)
  t$pilot$press("end", "enter")
  t$pilot$type("x")
  expect_identical(t$ed$value, "  indented\n  x")
  u <- ta_app("a", width = 30, tab_behavior = "indent", tab_size = 4)
  u$pilot$press("tab")
  expect_identical(u$ed$value, "    a")
  u$pilot$press("shift+tab")
  expect_identical(u$ed$value, "a")
  # By default Tab leaves the editor (focus moves on).
  v <- ta_app("a", width = 30)
  v$pilot$press("tab")
  expect_identical(v$ed$value, "a")
})

test_that("read-only areas can be navigated but not edited", {
  t <- ta_app("fixed text", width = 30, read_only = TRUE)
  t$pilot$type("zzz")
  t$pilot$press("backspace", "enter")
  t$pilot$paste("pasted")
  expect_identical(t$ed$value, "fixed text")
  t$pilot$press("end", "shift+left")
  expect_identical(t$ed$selection, "t")
  t$pilot$press("ctrl+c")
  expect_identical(t$app$clipboard, "t")
})

test_that("graphemes are never split", {
  t <- ta_app("a\U0001F468\u200d\U0001F469\u200d\U0001F467e\u0301b", width = 30)
  t$pilot$press("right", "right")
  expect_identical(t$ed$cursor_column, 3L)
  t$pilot$press("backspace")
  expect_identical(t$ed$value, "ae\u0301b")
  t$pilot$press("end", "left", "left", "shift+left")
  expect_identical(t$ed$selection, "a")
  expect_identical(t$ed$cursor_column, 1L)
})

test_that("events: changed and selection_changed", {
  log <- character()
  t <- ta_app("abc", width = 30)
  t$app$on("*", function(event, app) {
    if (startsWith(event$type, "textarea.")) log <<- c(log, event$type)
  })
  t$pilot$type("x")
  t$pilot$press("shift+left")
  t$pilot$press("left")
  expect_true("textarea.changed" %in% log)
  expect_true("textarea.selection_changed" %in% log)
})

test_that("validation sets the invalid state", {
  t <- ta_app("", width = 30, validate = function(v) if (!nzchar(v)) "required")
  expect_false(t$ed$valid)
  expect_identical(t$ed$error, "required")
  t$pilot$type("a")
  expect_true(t$ed$valid)
  expect_identical(t$ed$computed_style()$border_color, "bright_cyan")
  t$pilot$press("backspace")
  expect_false(t$ed$valid)
  expect_identical(t$ed$computed_style()$border_color, "bright_red")
})

test_that("scrolling follows the cursor and the wheel", {
  text <- paste0("line ", 1:50, collapse = "\n")
  t <- ta_app(text, width = 20, height = 7)
  expect_match(t$pilot$screen_text()[[2]], "^\u2502line 1 ")
  t$pilot$press("ctrl+end")
  scr <- t$pilot$screen_text()
  expect_match(scr[[6]], "^\u2502line 50")
  expect_match(scr[[2]], "^\u2502line 46")
  t$pilot$press("pageup")
  expect_identical(t$ed$cursor_row, 46L)
  t$pilot$scroll(5, direction = "up", y = 3)
  expect_match(t$pilot$screen_text()[[2]], "^\u2502line ")
  t$pilot$press("ctrl+home")
  expect_match(t$pilot$screen_text()[[2]], "^\u2502line 1 ")
  # The scroll bar thumb is drawn.
  expect_true(any(grepl("\u2588", t$pilot$screen_text())))
})

test_that("horizontal scrolling without wrap", {
  t <- ta_app(strrep("0123456789", 6), width = 20, height = 5, wrap = FALSE)
  t$pilot$press("end")
  scr <- t$pilot$screen_text()
  expect_match(scr[[2]], "89 ?\u2502$|89.\u2502$|9 +\u2502$")
  expect_false(grepl("^\u2502012", scr[[2]]))
  t$pilot$press("home")
  expect_match(t$pilot$screen_text()[[2]], "^\u2502012345")
})

test_that("mouse click places the cursor and dragging selects", {
  t <- ta_app("hello\nworld", width = 20, height = 6)
  t$pilot$click(4, 3)
  expect_identical(c(t$ed$cursor_row, t$ed$cursor_column), c(2L, 3L))
  t$pilot$mouse("down", 3, 2, button = "left")
  t$pilot$mouse("move", 5, 3, button = "left")
  t$pilot$mouse("up", 5, 3, button = "left")
  expect_identical(t$ed$selection, "ello\nwor")
})

test_that("find: next, previous, wrap, case and regex", {
  t <- ta_app("Foo bar\nfoo baz\nxx FOO", width = 30)
  expect_true(t$ed$find("foo"))
  expect_identical(t$ed$selection, "Foo")
  t$ed$find_next()
  expect_identical(c(t$ed$cursor_row, t$ed$selection), c(2L, "foo"))
  t$ed$find_next()
  expect_identical(c(t$ed$cursor_row, t$ed$selection), c(3L, "FOO"))
  t$ed$find_next()
  expect_identical(c(t$ed$cursor_row, t$ed$selection), c(1L, "Foo"))
  t$ed$find_previous()
  expect_identical(c(t$ed$cursor_row, t$ed$selection), c(3L, "FOO"))
  expect_identical(t$ed$match_count, 3L)
  t$ed$find("foo", case_sensitive = TRUE)
  expect_identical(t$ed$match_count, 1L)
  expect_identical(t$ed$selection, "foo")
  expect_true(t$ed$find("b[a-z]+", regex = TRUE))
  expect_error(t$ed$find("(", regex = TRUE), "Invalid regular expression")
  expect_false(t$ed$find("nothing"))
})

test_that("the find bar edits the query incrementally", {
  t <- ta_app("alpha\nbeta\nalphabet", width = 30, height = 7)
  t$pilot$press("ctrl+f")
  expect_true(t$ed$find_open)
  t$pilot$type("alp")
  expect_identical(t$ed$selection, "alp")
  expect_identical(t$ed$match_count, 2L)
  expect_true(any(grepl("Find: alp_", t$pilot$screen_text())))
  t$pilot$press("enter")
  expect_identical(t$ed$cursor_row, 3L)
  t$pilot$press("backspace", "backspace", "backspace")
  t$pilot$type("zzz")
  expect_true(any(grepl("no matches", t$pilot$screen_text())))
  t$pilot$press("ctrl+r")
  t$pilot$press("backspace", "backspace", "backspace")
  t$pilot$type("(")
  expect_true(any(grepl("bad regex", t$pilot$screen_text())))
  t$pilot$press("escape")
  expect_false(t$ed$find_open)
  # Typing goes to the text again.
  t$pilot$type("Q")
  expect_match(t$ed$value, "Q")
})

test_that("set_text resets history and goto_line works", {
  t <- ta_app("a\nb\nc", width = 30)
  t$pilot$type("x")
  t$ed$set_text("p\nq")
  expect_false(t$ed$can_undo)
  expect_identical(t$ed$n_lines, 2L)
  t$ed$goto_line(2, 2)
  expect_identical(c(t$ed$cursor_row, t$ed$cursor_column), c(2L, 2L))
  t$ed$select_range(1, 1, 2, 2)
  expect_identical(t$ed$selection, "p\nq")
})

test_that("placeholder is shown while empty", {
  t <- ta_app("", width = 30, placeholder = "Write here")
  expect_true(any(grepl("Write here", t$pilot$screen_text())))
  t$pilot$type("a")
  expect_false(any(grepl("Write here", t$pilot$screen_text())))
})

test_that("control characters in the text never reach the terminal", {
  t <- ta_app("", width = 30)
  t$ed$set_text("a\u001b[31mb\u0007c\u009bd")
  t$pilot$step()
  out <- paste(t$pilot$driver$output, collapse = "")
  expect_false(grepl("\u001b[31m", out, fixed = TRUE))
  expect_false(grepl("\u0007", out, fixed = TRUE))
})

test_that("replace APIs are undoable and replace-all reports counts", {
  ed <- text_area("cat cat\ndog cat")
  expect_true(ed$replace("fox", query = "cat"))
  expect_identical(ed$value, "fox cat\ndog cat")
  expect_identical(ed$replace_all("cat", "lynx"), 2L)
  expect_identical(ed$value, "fox lynx\ndog lynx")
  expect_true(ed$undo())
  expect_identical(ed$value, "fox cat\ndog cat")
  expect_error(ed$replace_all("(", "x", regex = TRUE), "Invalid regular expression")
})

test_that("oversized edits do not exceed the undo memory budget", {
  ed <- text_area("")
  ed$insert(strrep("x", 2000001L), kind = "paste")
  expect_lte(ed$history_size, 2e6)
  expect_false(ed$can_undo)
})

test_that("goto-line UI and cursor positions distinguish graphemes from cells", {
  ed <- text_area("\\u00e9\\u754ca\nsecond\nthird")
  expect_identical(ed$cursor_position(), list(line = 1L, grapheme_column = 1L, display_column = 1L))
  ed$goto_line(1, 3)
  expect_identical(ed$cursor_position(), list(line = 1L, grapheme_column = 3L, display_column = 3L))
  pilot <- test_app(app(ed), 30, 5)
  pilot$press("ctrl+g")
  pilot$type("3")
  pilot$press("enter")
  expect_identical(ed$cursor_row, 3L)
})

test_that("replace bar replaces all and R highlighter tokenizes incomplete code", {
  ed <- text_area("if (TRUE) 42", highlighter = r_highlighter(), language = "r")
  buf <- render_widget(ed, 30, 3)
  expect_false(identical(buf$get_cell(2, 2)$fg, ""))
  pilot <- test_app(app(ed), 30, 4)
  pilot$press("ctrl+f", "alt+r")
  pilot$type("if")
  pilot$press("tab")
  pilot$type("else")
  pilot$press("ctrl+enter")
  expect_identical(ed$value, "else (TRUE) 42")
  broken <- text_area("abc", highlighter = function(lines, state = NULL) list(data.frame(foo = 1)))
  expect_error(render_widget(broken, 20, 3), "start.*end.*token")
})

test_that("wrapping starts keep every grapheme exactly once", {
  set.seed(3)
  for (i in 1:50) {
    n <- sample(1:60, 1)
    chars <- sample(c("a", "b", " ", "\u4e2d"), n, replace = TRUE)
    widths <- ifelse(chars == "\u4e2d", 2L, 1L)
    w <- sample(3:12, 1)
    starts <- editor_wrap_starts(chars, widths, w)
    expect_identical(starts[[1]], 1L)
    expect_true(all(diff(starts) > 0L))
    ends <- c(starts[-1] - 1L, n)
    for (k in seq_along(starts)) {
      row_w <- sum(widths[starts[[k]]:ends[[k]]])
      # A row fits, except for a single wide character or one hanging space.
      expect_true(row_w <= w + 1L, info = paste(i, k))
    }
  }
})