tests/testthat/test-contextmenu.R

In leaflet.extras2: Extra Functionality for 'leaflet' Package

test_that("contextmenu", {
  m <- leaflet(options = leafletOptions(
    contextmenu = TRUE,
    contextmenuWidth = 200,
    contextmenuItems =
      context_mapmenuItems(
        context_menuItem("Zoom Out", "function(e) {this.zoomOut()}", disabled=FALSE),
        "-",
        context_menuItem("Zoom In", "function(e) {this.zoomIn()}")))) %>%
    addTiles(group = "base") %>%
    addContextmenu() %>%
    addMarkers(data = breweries91, label = ~brewery,
               layerId = ~founded, group = "marker",
               options = markerOptions(
                 contextmenu = TRUE,
                 contextmenuWidth = 200,
                 contextmenuItems =
                   context_markermenuItems(
                     context_menuItem(text = "Show Marker Coords",
                              callback = "function(e) {alert(e.latlng);}",
                              index = 1)
                   )
               ))

  expect_is(m, "leaflet")
  expect_true(m$x$options$contextmenu)
  expect_is(m$x$options$contextmenuWidth, "numeric")
  expect_is(m$x$options$contextmenuItems, "list")
  expect_is(m$x$options$contextmenuItems[[1]]$callback, "JS_EVAL")

  deps <- findDependencies(m)
  expect_equal(deps[[length(deps)]]$name, "lfx-contextmenu")

  m <- m %>% showContextmenu(data = leaflet::breweries91[sample(1:32, 1),])
  expect_equal(m$x$calls[[length(m$x$calls)]]$method,
               "showContextmenu")
  expect_true(all(colnames(m$x$calls[[length(m$x$calls)]]$args[[1]]) %in% c("lng","lat")))

  m <- m %>% showContextmenu(lat = 49.79433, lng = 11.50941)
  expect_equal(m$x$calls[[length(m$x$calls)]]$method,
               "showContextmenu")
  expect_true(all(colnames(m$x$calls[[length(m$x$calls)]]$args[[1]]) %in% c("lng","lat")))

  m <- m %>% hideContextmenu()
  expect_equal(m$x$calls[[length(m$x$calls)]]$method,
               "hideContextmenu")

  if (packageVersion("leaflet") < "2.0.4") {
    m <- expect_warning(
      m %>% addItemContextmenu(
        context_menuItem(text = "Added Menu Item",
               callback = ("function(e) {alert('I am a new menuItem!');
                                             console.log('e');console.log(e);}")))
    )
    expect_equal(m$x$calls[[length(m$x$calls)]]$method,
                 "addItemContextmenu")

    m <- expect_warning(
      m %>% insertItemContextmenu(index = 1,
          context_menuItem(text = "Inserted Menu Item",
                 callback = ("function(e) {alert('I am an inserted menuItem!');}")))
    )
    expect_equal(m$x$calls[[length(m$x$calls)]]$method,
                 "insertItemContextmenu")

  } else {
    m <- m %>% addItemContextmenu(
      context_menuItem(text = "Added Menu Item",
                 callback = ("function(e) {alert('I am a new menuItem!');
                                             console.log('e');console.log(e);}")))
    expect_equal(m$x$calls[[length(m$x$calls)]]$method,
                 "addItemContextmenu")

    m <- m %>% insertItemContextmenu(index = 2,
           context_menuItem(text = "Added Menu Item",
                 callback = ("function(e) {alert('I am an inserted menuItem!');}")))
    expect_equal(m$x$calls[[length(m$x$calls)]]$method,
                 "insertItemContextmenu")
  }

  m <- m %>% removeItemContextmenu(index=1)
  expect_equal(m$x$calls[[length(m$x$calls)]]$method,
               "removeItemContextmenu")
  expect_true(m$x$calls[[length(m$x$calls)]]$args[[1]] == 1)

  m <- m %>% setDisabledContextmenu(index=1, disabled = TRUE)
  expect_equal(m$x$calls[[length(m$x$calls)]]$method,
               "setDisabledContextmenu")
  expect_true(m$x$calls[[length(m$x$calls)]]$args[[1]] == 1)
  expect_true(m$x$calls[[length(m$x$calls)]]$args[[2]] == TRUE)

  m <- m %>% setDisabledContextmenu(index=2, disabled = FALSE)
  expect_equal(m$x$calls[[length(m$x$calls)]]$method,
               "setDisabledContextmenu")
  expect_true(m$x$calls[[length(m$x$calls)]]$args[[1]] == 2)
  expect_true(m$x$calls[[length(m$x$calls)]]$args[[2]] == FALSE)

  m <- m %>% removeallItemsContextmenu()
  expect_equal(m$x$calls[[length(m$x$calls)]]$method,
               "removeallItemsContextmenu")


  mn <- context_menuItem("some text", "my callback", id="myid")
  expect_is(mn, "list")
  expect_is(mn$callback, "JS_EVAL")

  mn1 <- context_menuItem(id="myid", "some text", "my callback")
  expect_identical(mn1, mn)

  mn <- context_mapmenuItems(
    context_menuItem("some text", "my callback", id="myid"),
    context_menuItem("some other text", "my callback", id="myid2")
  )
  expect_is(mn, "list")
  expect_length(mn, 2)

  mn <- context_markermenuItems(
    context_menuItem("some text", "my callback", id="myid"),
    context_menuItem("some other text", "my callback", id="myid2")
  )
  expect_is(mn, "list")
  expect_length(mn, 1)
})



test_that("contextmenu-deprecation", {
  mn <- expect_warning(menuItem("some text", "my callback", id="myid"))
  expect_is(mn, "list")
  expect_is(mn$callback, "JS_EVAL")

  mn1 <- expect_warning(menuItem(id="myid", "some text", "my callback"))
  expect_identical(mn1, mn)

  mn <- expect_warning(markermenuItems(
    menuItem("some text", "my callback", id="myid"),
    menuItem("some other text", "my callback", id="myid2")
  ))
  expect_is(mn, "list")
  expect_length(mn, 1)

  cnt <- expect_warning(mapmenuItems(
    context_menuItem("Zoom In", "function(e) {this.zoomIn()}"))
  )
  expect_is(cnt, "list")
  expect_length(cnt, 1)
  expect_identical(cnt[[1]]$text, "Zoom In")
  expect_is(cnt[[1]]$callback, "JS_EVAL")
})