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"
  )

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

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

  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")
})