Nothing
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")
})
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.