From 5714e4fd5a9555a1da4679b91d280f0c79209f1c Mon Sep 17 00:00:00 2001 From: Joe Cheng Date: Thu, 23 Apr 2015 15:40:51 -0700 Subject: [PATCH 01/15] Initial sketch of Shiny support --- NAMESPACE | 9 +++++ R/layers.R | 75 ++++++++++++++++++++++++++++++++++++- R/methods.R | 44 +++++++++++++++++----- R/utils.R | 67 +++++++++++++++++++++++++++++---- inst/htmlwidgets/leaflet.js | 48 +++++++++++++++++++++--- man/map-layers.Rd | 6 +-- 6 files changed, 223 insertions(+), 26 deletions(-) diff --git a/NAMESPACE b/NAMESPACE index c58141e62..c99d9b876 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -15,12 +15,17 @@ export(addPopups) export(addRectangles) export(addTiles) export(clearBounds) +export(clearMarkers) +export(clearPopups) +export(clearShapes) +export(clearTiles) export(colorBin) export(colorFactor) export(colorNumeric) export(colorQuantile) export(createLeafletMap) export(fitBounds) +export(getMapProxy) export(leaflet) export(leafletMap) export(leafletOutput) @@ -29,6 +34,10 @@ export(markerOptions) export(pathOptions) export(popupOptions) export(previewColors) +export(removeMarker) +export(removePopup) +export(removeShape) +export(removeTiles) export(renderLeaflet) export(setView) export(tileOptions) diff --git a/R/layers.R b/R/layers.R index 3c818aa81..1a5ef1f95 100644 --- a/R/layers.R +++ b/R/layers.R @@ -70,6 +70,7 @@ addTiles = function( map, urlTemplate = 'http://{s}.tile.openstreetmap.org/{z}/{x}/{y}.png', attribution = NULL, + layerId = NULL, options = tileOptions() ) { options$attribution = attribution @@ -78,7 +79,7 @@ addTiles = function( '© OpenStreetMap', 'contributors, CC-BY-SA' ) - appendMapData(map, getMapData(map), 'tileLayer', urlTemplate, options) + appendMapData(map, getMapData(map), 'tileLayer', urlTemplate, layerId, options) } #' Extra options for map elements and layers @@ -122,6 +123,24 @@ tileOptions = function( ) } +#' @export +removeTiles = function(map, layerId) { + dispatch(map, + remote = { + invokeRemote(map, 'removeTileLayer', layerId); + } + ) +} + +#' @export +clearTiles = function(map) { + dispatch(map, + remote = { + invokeRemote(map, 'clearTileLayers') + } + ) +} + #' @param lng a numeric vector of longitudes, or a one-sided formula of the form #' \code{~x} where \code{x} is a variable in \code{data}; by default (if not #' explicitly provided), it will be automatically inferred from \code{data} by @@ -177,6 +196,24 @@ popupOptions = function( ) } +#' @export +removePopup = function(map, layerId) { + dispatch(map, + remote = { + invokeRemote(map, 'removePopup', layerId); + } + ) +} + +#' @export +clearPopups = function(map) { + dispatch(map, + remote = { + invokeRemote(map, 'clearPopups') + } + ) +} + #' @param icon the icon for markers; if you want to create a new icon using #' JavaScript, please remember to use \code{\link[htmlwidgets]{JS}()} on the #' JavaScript string; see \url{http://leafletjs.com/reference.html#icon} @@ -260,6 +297,24 @@ addCircleMarkers = function( expandLimits(pts$lat, pts$lng) } +#' @export +removeMarker = function(map, layerId) { + dispatch(map, + remote = { + invokeRemote(map, 'removeMarker', layerId); + } + ) +} + +#' @export +clearMarkers = function(map) { + dispatch(map, + remote = { + invokeRemote(map, 'clearMarkers') + } + ) +} + #' @param lineCap a string that defines #' \href{https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/stroke-linecap}{shape #' to be used at the end} of the stroke @@ -402,6 +457,24 @@ addPolygons = function( expandLimitsBbox(pgons) } +#' @export +removeShape = function(map, layerId) { + dispatch(map, + remote = { + invokeRemote(map, 'removeShape', layerId); + } + ) +} + +#' @export +clearShapes = function(map) { + dispatch(map, + remote = { + invokeRemote(map, 'clearShapes') + } + ) +} + #' @param geojson a GeoJSON list #' @describeIn map-layers Add GeoJSON layers to the map #' @export diff --git a/R/methods.R b/R/methods.R index f7aef2332..2b7488f50 100644 --- a/R/methods.R +++ b/R/methods.R @@ -17,18 +17,37 @@ #' m %>% fitBounds(-72, 40, -70, 43) #' m %>% clearBounds() # world view setView = function(map, lng, lat, zoom, options = list()) { - map$x$setView = list(c(lat, lng), zoom, options) - map$x$fitBounds = NULL - map + view = list(c(lat, lng), zoom, options) + + dispatch(map, + local = { + map$x$setView = view + map$x$fitBounds = NULL + map + }, + remote = { + invokeRemote(map, "setView", view) + map + } + ) } #' @describeIn map-methods Set the bounds of a map #' @param lng1,lat1,lng2,lat2 the coordinates of the map bounds #' @export fitBounds = function(map, lng1, lat1, lng2, lat2) { - map$x$fitBounds = list(lat1, lng1, lat2, lng2) - map$x$setView = NULL - map + bounds = list(lat1, lng1, lat2, lng2) + + dispatch(map, + local = { + map$x$fitBounds = bounds + map$x$setView = NULL + map + }, + remote = { + invokeRemote(map, "fitBounds", bounds) + } + ) } #' @describeIn map-methods Clear the bounds of a map, and the bounds will be @@ -36,7 +55,14 @@ fitBounds = function(map, lng1, lat1, lng2, lat2) { #' if available (otherwise the full world view is used) #' @export clearBounds = function(map) { - map$x$fitBounds = NULL - map$x$setView = NULL - map + dispatch(map, + local = { + map$x$fitBounds = NULL + map$x$setView = NULL + map + }, + remote = { + + } + ) } diff --git a/R/utils.R b/R/utils.R index 0c86f6dd5..f6e73f52c 100644 --- a/R/utils.R +++ b/R/utils.R @@ -1,3 +1,15 @@ +dispatch = function(map, + local = stop("Operation requires a map proxy object"), + remote = stop("Operation does not support map proxy objects") +) { + if (inherits(map, "leaflet")) + return(local) + else if (inherits(map, "leaflet_remote")) + return(remote) + else + stop("Invalid map parameter") +} + # remove NULL elements from a list filterNULL = function(x) { if (length(x) == 0 || !is.list(x)) return(x) @@ -5,15 +17,54 @@ filterNULL = function(x) { } appendMapData = function(map, data, component, ...) { - x = map$x$calls - if (is.null(x)) x = list() - n = length(x) - x[[n + 1]] = list( - method = component, - args = evalFormula(list(...), data) + method = component + args = evalFormula(list(...), data) + + dispatch(map, + local = { + x = map$x$calls + if (is.null(x)) x = list() + n = length(x) + x[[n + 1]] = list(method = component, args = args) + map$x$calls = x + map + }, + remote = { + invokeRemote(map, method, args) + map + } ) - map$x$calls = x - map +} + +#' @export +getMapProxy <- function(mapId, session = shiny::getDefaultReactiveDomain(), + data = NULL) { + structure( + list( + session = session, + id = mapId, + x = structure( + list(), + leafletData = data + ) + ), + class = "leaflet_remote" + ) +} + +invokeRemote = function(map, method, args = list()) { + if (!inherits(map, "leaflet_remote")) + stop("Invalid map parameter; map proxy object was expected") + + map$session$sendCustomMessage("leaflet-calls", list( + id = map$id, + calls = list( + list( + method = method, + args = args + ) + ) + )) } # A helper function to generate the body of function(x, y) list(x = x, y = y), diff --git a/inst/htmlwidgets/leaflet.js b/inst/htmlwidgets/leaflet.js index ab9cc77ee..b52565b3e 100644 --- a/inst/htmlwidgets/leaflet.js +++ b/inst/htmlwidgets/leaflet.js @@ -166,9 +166,16 @@ var dataframe = (function() { }; LayerStore.prototype.remove = function(id) { - if (this._layers[id]) { - this._group.removeLayer(this._layers[id]); - delete this._layers[id]; + if (typeof(id) === 'undefined' || id === null) { + return; + } + + id = asArray(id); + for (var i = 0; i < id.length; i++) { + if (this._layers[id[i]]) { + this._group.removeLayer(this._layers[id[i]]); + delete this._layers[id[i]]; + } } }; @@ -264,8 +271,16 @@ var dataframe = (function() { this.popups.clear(); }; - methods.tileLayer = function(urlTemplate, options) { - this.tiles.add(L.tileLayer(urlTemplate, options)); + methods.tileLayer = function(urlTemplate, layerId, options) { + this.tiles.add(L.tileLayer(urlTemplate, options), layerId); + }; + + methods.removeTileLayer = function(layerId) { + this.tiles.remove(layerId); + }; + + methods.clearTileLayers = function() { + this.tiles.clear(); }; methods.marker = function(lat, lng, layerId, options, popup) { @@ -490,6 +505,9 @@ var dataframe = (function() { map.id = this.getId(el); + // Store the map on the element so we can find it later by ID + $(el).data("leaflet-map", map); + // When the map is clicked, send the coordinates back to the app map.on('click', function(e) { Shiny.onInputChange(map.id + '_click', { @@ -564,6 +582,8 @@ var dataframe = (function() { var call = data.calls[i]; if (methods[call.method]) methods[call.method].apply(map, call.args); + else + console.log("Unknown method " + call.method); } map.leafletr.hasRendered = true; @@ -579,6 +599,24 @@ var dataframe = (function() { if (!HTMLWidgets.shinyMode) return; + Shiny.addCustomMessageHandler('leaflet-calls', function(data) { + var id = data.id; + var el = document.getElementById(id); + var map = el ? $(el).data('leaflet-map') : null; + if (!map) { + console.log("Couldn't find map with id " + id); + return; + } + + for (var i = 0; i < data.calls.length; i++) { + var call = data.calls[i]; + if (methods[call.method]) + methods[call.method].apply(map, call.args); + else + console.log("Unknown method " + call.method); + } + }); + // Shiny support via the Leaflet map controller Shiny.addCustomMessageHandler('leaflet', function(data) { var mapId = data.mapId; diff --git a/man/map-layers.Rd b/man/map-layers.Rd index b9757303c..eab0febe8 100644 --- a/man/map-layers.Rd +++ b/man/map-layers.Rd @@ -12,7 +12,7 @@ \title{Graphics elements and layers} \usage{ addTiles(map, urlTemplate = "http://{s}.tile.openstreetmap.org/{z}/{x}/{y}.png", - attribution = NULL, options = tileOptions()) + attribution = NULL, layerId = NULL, options = tileOptions()) addPopups(map, lng = NULL, lat = NULL, popup, layerId = NULL, options = popupOptions(), data = getMapData(map)) @@ -54,6 +54,8 @@ addGeoJSON(map, geojson, layerId = NULL) \item{attribution}{the attribution text of the tile layer (HTML)} +\item{layerId}{the layer id} + \item{options}{a list of extra options for tile layers, popups, paths (circles, rectangles, polygons, ...), or other map elements} @@ -71,8 +73,6 @@ the latitude column from \code{data})} recommended to escape the text using \code{\link[htmltools]{htmlEscape}()} for security reasons)} -\item{layerId}{the layer id} - \item{data}{the data object from which the argument values are derived; by default, it is the \code{data} object provided to \code{leaflet()} initially, but can be overridden} From 65bda2120f74a596449515a14a96463a2e59f0f1 Mon Sep 17 00:00:00 2001 From: Joe Cheng Date: Fri, 24 Apr 2015 10:05:05 -0700 Subject: [PATCH 02/15] Docs and examples --- R/utils.R | 48 +++++++++++++++++++++++++++++++++++++++++ inst/examples/shiny.R | 9 ++++++++ man/getMapProxy.Rd | 50 +++++++++++++++++++++++++++++++++++++++++++ 3 files changed, 107 insertions(+) create mode 100644 man/getMapProxy.Rd diff --git a/R/utils.R b/R/utils.R index f6e73f52c..3c96cfda2 100644 --- a/R/utils.R +++ b/R/utils.R @@ -36,6 +36,54 @@ appendMapData = function(map, data, component, ...) { ) } +#' Send commands to a Leaflet instance in a Shiny app +#' +#' Creates a map-like object that can be used to customize and control a map +#' that has already been rendered. For use in Shiny apps and Shiny docs only. +#' +#' Normally, you create a Leaflet map using the \code{\link{leaflet}} function. +#' This creates an in-memory representation of a map that you can customize +#' using functions like \code{\link{addPolygons}} and \code{\link{setView}}. +#' Such a map can be printed at the R console, included in an R Markdown +#' document, or rendered as a Shiny output. +#' +#' In the case of Shiny, you may want to further customize a map, even after it +#' is rendered to an output. At this point, the in-memory representation of the +#' map is long gone, and the user's web browser has already realized the Leaflet +#' map instance. +#' +#' This is where \code{getMapProxy} comes in. It returns an object that can +#' stand in for the usual Leaflet map object. The usual map functions like +#' \code{\link{addPolygons}} and \code{\link{setView}} can be called, and +#' instead of customizing an in-memory representation, these commands will +#' execute on the live Leaflet map instance. +#' +#' @examples +#' \donttest{ +#' library(shiny) +#' +#' ui <- fluidPage( +#' leafletOutput("map1") +#' ) +#' +#' server <- function(input, output, session) { +#' output$map1 <- renderLeaflet({ +#' leaflet() %>% addCircleMarkers( +#' lng = runif(10), +#' lat = runif(10), +#' layerId = paste0("marker", 1:10)) +#' }) +#' +#' observeEvent(input$map1_marker_click, { +#' getMapProxy("map1", session) %>% +#' removeMarker(input$map1_marker_click$id) +#' }) +#' } +#' +#' shinyApp(ui, server) +#' +#' } +#' #' @export getMapProxy <- function(mapId, session = shiny::getDefaultReactiveDomain(), data = NULL) { diff --git a/inst/examples/shiny.R b/inst/examples/shiny.R index 3d45fbcb1..d1be1caae 100644 --- a/inst/examples/shiny.R +++ b/inst/examples/shiny.R @@ -5,6 +5,8 @@ geodata <- paste(readLines(system.file("examples/test.json", package = "leaflet" ui <- fluidPage( leafletOutput("map1"), + checkboxInput("addMarker", "Add marker on click"), + actionButton("clearMarkers", "Clear all markers"), textOutput("message", container = h3) ) @@ -38,6 +40,10 @@ server <- function(input, output, session) { }) observeEvent(input$map1_click, { v$msg <- paste("Clicked map at", input$map1_click$lat, "/", input$map1_click$lng) + if (input$addMarker) { + getMapProxy("map1") %>% + addMarkers(lng = input$map1_click$lng, lat = input$map1_click$lat) + } }) observeEvent(input$map1_zoom, { v$msg <- paste("Zoom changed to", input$map1_zoom) @@ -45,6 +51,9 @@ server <- function(input, output, session) { observeEvent(input$map1_bounds, { v$msg <- paste("Bounds changed to", paste(input$map1_bounds, collapse = ", ")) }) + observeEvent(input$clearMarkers, { + getMapProxy("map1") %>% clearMarkers() + }) output$message <- renderText(v$msg) } diff --git a/man/getMapProxy.Rd b/man/getMapProxy.Rd new file mode 100644 index 000000000..d5ff8eb40 --- /dev/null +++ b/man/getMapProxy.Rd @@ -0,0 +1,50 @@ +% Please edit documentation in R/utils.R +\name{getMapProxy} +\alias{getMapProxy} +\title{Send commands to a Leaflet instance in a Shiny app} +\usage{ +getMapProxy(mapId, session = shiny::getDefaultReactiveDomain(), data = NULL) +} +\description{ +Creates a map-like object that can be used to customize and control a map +that has already been rendered. For use in Shiny apps and Shiny docs only. +} +\details{ +Normally, you create a Leaflet map using the \code{\link{leaflet}} function. +This creates an in-memory representation of a map that you can customize +using functions like \code{\link{addPolygons}} and \code{\link{setView}}. +Such a map can be printed at the R console, included in an R Markdown +document, or rendered as a Shiny output. + +In the case of Shiny, you may want to further customize a map, even after it +is rendered to an output. At this point, the in-memory representation of the +map is long gone, and the user's web browser has already realized the Leaflet +map instance. + +This is where \code{getMapProxy} comes in. It returns an object that can +stand in for the usual Leaflet map object. The usual map functions like +\code{\link{addPolygons}} and \code{\link{setView}} can be called, and +instead of customizing an in-memory representation, these commands will +execute on the live Leaflet map instance. +} +\examples{ +\donttest{ +library(shiny) + +ui <- fluidPage(leafletOutput("map1")) + +server <- function(input, output, session) { + output$map1 <- renderLeaflet({ + leaflet() \%>\% addCircleMarkers(lng = runif(10), lat = runif(10), + layerId = paste0("marker", 1:10)) + }) + + observeEvent(input$map1_marker_click, { + getMapProxy("map1", session) \%>\% removeMarker(input$map1_marker_click$id) + }) +} + +shinyApp(ui, server) + +} +} From 1d5c4720a631bf4135b95c6574ee7f6fdba8890b Mon Sep 17 00:00:00 2001 From: Joe Cheng Date: Fri, 24 Apr 2015 10:14:24 -0700 Subject: [PATCH 03/15] Simplify removeXXX/clearXXX functions; support local/remote --- R/layers.R | 48 ++++++++---------------------------------------- 1 file changed, 8 insertions(+), 40 deletions(-) diff --git a/R/layers.R b/R/layers.R index 1a5ef1f95..4d6494d47 100644 --- a/R/layers.R +++ b/R/layers.R @@ -125,20 +125,12 @@ tileOptions = function( #' @export removeTiles = function(map, layerId) { - dispatch(map, - remote = { - invokeRemote(map, 'removeTileLayer', layerId); - } - ) + appendMapData(map, NULL, 'removeTileLayer', layerId) } #' @export clearTiles = function(map) { - dispatch(map, - remote = { - invokeRemote(map, 'clearTileLayers') - } - ) + appendMapData(map, NULL, 'clearTileLayers') } #' @param lng a numeric vector of longitudes, or a one-sided formula of the form @@ -198,20 +190,12 @@ popupOptions = function( #' @export removePopup = function(map, layerId) { - dispatch(map, - remote = { - invokeRemote(map, 'removePopup', layerId); - } - ) + appendMapData(map, NULL, 'removePopup', layerId) } #' @export clearPopups = function(map) { - dispatch(map, - remote = { - invokeRemote(map, 'clearPopups') - } - ) + appendMapData(map, NULL, 'clearPopups') } #' @param icon the icon for markers; if you want to create a new icon using @@ -299,20 +283,12 @@ addCircleMarkers = function( #' @export removeMarker = function(map, layerId) { - dispatch(map, - remote = { - invokeRemote(map, 'removeMarker', layerId); - } - ) + appendMapData(map, NULL, 'removeMarker', layerId) } #' @export clearMarkers = function(map) { - dispatch(map, - remote = { - invokeRemote(map, 'clearMarkers') - } - ) + appendMapData(map, NULL, 'clearMarkers') } #' @param lineCap a string that defines @@ -459,20 +435,12 @@ addPolygons = function( #' @export removeShape = function(map, layerId) { - dispatch(map, - remote = { - invokeRemote(map, 'removeShape', layerId); - } - ) + appendMapData(map, NULL, 'removeShape', layerId) } #' @export clearShapes = function(map) { - dispatch(map, - remote = { - invokeRemote(map, 'clearShapes') - } - ) + appendMapData(map, NULL, 'clearShapes') } #' @param geojson a GeoJSON list From 92b201c88f3a21cf9a9c5f2e25a1330f25e58133 Mon Sep 17 00:00:00 2001 From: Joe Cheng Date: Fri, 24 Apr 2015 10:15:18 -0700 Subject: [PATCH 04/15] Raise error on clearBounds() for remote --- R/methods.R | 3 --- 1 file changed, 3 deletions(-) diff --git a/R/methods.R b/R/methods.R index 2b7488f50..0d0162dd8 100644 --- a/R/methods.R +++ b/R/methods.R @@ -60,9 +60,6 @@ clearBounds = function(map) { map$x$fitBounds = NULL map$x$setView = NULL map - }, - remote = { - } ) } From 33b8fdecbaf7db36fd6459b1d4e88089725bf0ab Mon Sep 17 00:00:00 2001 From: Joe Cheng Date: Fri, 24 Apr 2015 10:17:42 -0700 Subject: [PATCH 05/15] Add comment --- R/utils.R | 3 +++ 1 file changed, 3 insertions(+) diff --git a/R/utils.R b/R/utils.R index 3c96cfda2..fa7f0f2c4 100644 --- a/R/utils.R +++ b/R/utils.R @@ -1,3 +1,6 @@ +# Given a local and/or remote operation and a map, execute one or the other +# depending on the type of the map object (regular or map proxy). If code was +# not provided for the appropriate mode, an error will be raised. dispatch = function(map, local = stop("Operation requires a map proxy object"), remote = stop("Operation does not support map proxy objects") From 4201e058ff1c073b8fd9e86e0350a0c16160f0be Mon Sep 17 00:00:00 2001 From: Joe Cheng Date: Fri, 24 Apr 2015 10:26:59 -0700 Subject: [PATCH 06/15] Open JS method table; clean up legacy code Can now add your own JS methods to window.Leaflet.methods, to be invoked from R. The method will be executed with "this" as the map object. --- R/shiny.R | 89 ------------------------------------- inst/htmlwidgets/leaflet.js | 17 +------ man/leafletController.Rd | 23 ---------- 3 files changed, 2 insertions(+), 127 deletions(-) delete mode 100644 man/leafletController.Rd diff --git a/R/shiny.R b/R/shiny.R index 6a47f3108..1d5afd3ed 100644 --- a/R/shiny.R +++ b/R/shiny.R @@ -29,92 +29,3 @@ renderLeaflet = function(expr, env = parent.frame(), quoted = FALSE) { if (!quoted) expr = substitute(expr) # force quoted htmlwidgets::shinyRenderWidget(expr, leafletOutput, env, quoted = TRUE) } - -#' Create a Leaflet map controller -#' -#' This function is called from \file{server.R} and returns an object that can -#' be used to manipulate the Leaflet map from R. -#' @param session The \code{session} argument passed through from the -#' \code{\link[shiny]{shinyServer}} server function. -#' @param id The string identifier that was passed to -#' \code{\link{leaflet}()}. -#' @return A list of methods. See the package vignette \code{vignette('intro', -#' 'leaflet'} for details. -#' @keywords internal -leafletController = function(session, id) { - - # This function is how we "dynamically" invoke code on the client. The - # method parameter indicates what leaflet operation we want to perform, - # and the other arguments will be serialized to JS objects and used as - # client side function args. - send = function(method, func, msg) { - - msg = msg[names(formals(func))] - names(msg) = NULL - - opts = options(digits = 22) - on.exit(options(opts)) - - session$sendCustomMessage('leaflet', list( - mapId = id, - method = method, - args = msg - )) - - } - - # Turns a call like: - # - # stub(expression(setView(lat, lng, zoom, forceReset = FALSE))) - # - # into: - # - # list(setView = function(lat, lng, zoom, forceReset = FALSE) { - # send("setView", sys.function(), as.list(environment())) - # }) - stub = function(p) { - # The function name is the first element - name = as.character(p[[1]]) - - # Get textual representation of the expression; change name to "function" - # and add a NULL function body - txt = paste(deparse(p), collapse = "\n") - txt = sub(name, "function", txt, fixed = TRUE) - txt = paste0(txt, "NULL") - - # Create the function - func = eval(parse(text = txt)) - - # Replace the function body - body(func) = substituteDirect( - quote(send(name, sys.function(), as.list(environment()))), - list(name = name) - ) - environment(func) = environment(send) - - # Return as list - structure(list(func), names = name) - } - - obj = lapply(expression( - setView(lat, lng, zoom, forceReset = FALSE), - addMarker(lat, lng, layerId = NULL, options = list()), - addCircleMarker(lat, lng, radius, layerId = NULL, options = list()), - clearMarkers(), - clearShapes(), - fitBounds(lat1, lng1, lat2, lng2), - addCircle(lat, lng, radius, layerId = NULL, options = list()), - addRectangle(lat1, lng1, lat2, lng2, layerId = NULL, options = list()), - addPolyline(lat, lng, layerId, options = list()), - addPolygon(lat, lng, layerId, options = list()), - addGeoJSON(data, layerId), - showPopup(lat, lng, content, layerId = NULL, options = list()), - removePopup(layerId), - clearPopups(), - removeShape(layerId), - clearShapes(), - removeMarker(layerId), - clearMarkers() - ), stub) - unlist(obj, recursive = FALSE) -} diff --git a/inst/htmlwidgets/leaflet.js b/inst/htmlwidgets/leaflet.js index b52565b3e..83e2a88ee 100644 --- a/inst/htmlwidgets/leaflet.js +++ b/inst/htmlwidgets/leaflet.js @@ -229,7 +229,8 @@ var dataframe = (function() { Shiny.onInputChange(id + '_zoom', map.getZoom()); } - var methods = {}; + window.LeafletWidget = {}; + var methods = window.LeafletWidget.methods = {}; methods.setView = function(center, zoom, options) { this.setView(center, zoom, options); @@ -617,20 +618,6 @@ var dataframe = (function() { } }); - // Shiny support via the Leaflet map controller - Shiny.addCustomMessageHandler('leaflet', function(data) { - var mapId = data.mapId; - var map = document.getElementById(mapId); - if (!map) - return; - - if (methods[data.method]) { - methods[data.method].apply(map, data.args); - } else { - throw new Error('Unknown method ' + data.method); - } - }); - })(); diff --git a/man/leafletController.Rd b/man/leafletController.Rd deleted file mode 100644 index 396815439..000000000 --- a/man/leafletController.Rd +++ /dev/null @@ -1,23 +0,0 @@ -% Please edit documentation in R/shiny.R -\name{leafletController} -\alias{leafletController} -\title{Create a Leaflet map controller} -\usage{ -leafletController(session, id) -} -\arguments{ -\item{session}{The \code{session} argument passed through from the -\code{\link[shiny]{shinyServer}} server function.} - -\item{id}{The string identifier that was passed to -\code{\link{leaflet}()}.} -} -\value{ -A list of methods. See the package vignette \code{vignette('intro', - 'leaflet'} for details. -} -\description{ -This function is called from \file{server.R} and returns an object that can -be used to manipulate the Leaflet map from R. -} -\keyword{internal} From ca4315a29ff5d22e4b9506b5022f9b29bfff4667 Mon Sep 17 00:00:00 2001 From: Joe Cheng Date: Fri, 24 Apr 2015 10:41:05 -0700 Subject: [PATCH 07/15] Add docs for removeXXX/clearXXX --- R/layers.R | 31 ++++++++++++++++++++++++++ man/map-layers.Rd | 3 +++ man/remove.Rd | 55 +++++++++++++++++++++++++++++++++++++++++++++++ 3 files changed, 89 insertions(+) create mode 100644 man/remove.Rd diff --git a/R/layers.R b/R/layers.R index 4d6494d47..0cd6fccbe 100644 --- a/R/layers.R +++ b/R/layers.R @@ -60,6 +60,7 @@ bboxAdd = function(a, b) { #' @param attribution the attribution text of the tile layer (HTML) #' @param options a list of extra options for tile layers, popups, paths #' (circles, rectangles, polygons, ...), or other map elements +#' @return the new \code{map} object #' @seealso \code{\link{tileOptions}}, \code{\link{popupOptions}}, #' \code{\link{markerOptions}}, \code{\link{pathOptions}} #' @references The Leaflet API documentation: @@ -123,11 +124,35 @@ tileOptions = function( ) } +#' Remove elements from a map +#' +#' Remove one or more features from a map, identified by \code{layerId}; or, +#' clear all features of the given type. +#' +#' @note When used with a \code{\link{leaflet}}() map object, these functions +#' don't actually remove the features from the map object, but simply add an +#' operation that will cause those features to be removed after they are added. +#' In other words, if you add a polygon \code{"foo"} and the call +#' \code{removeShape("foo")}, it's not smart enough to prevent the polygon from +#' being added in the first place; instead, when the map is rendered, the +#' polygon will be added and then removed. +#' +#' For that reason, these functions aren't that useful with \code{leaflet} map +#' objects and are really intended to be used with \code{\link{getMapProxy}} +#' instead. +#' +#' @param map a map widget object, possibly created from \code{\link{leaflet}}() +#' but more likely from \code{\link{getMapProxy}}() +#' @param layerId character vector; the layer id(s) of the item to remove +#' @return the new \code{map} object +#' +#' @name remove #' @export removeTiles = function(map, layerId) { appendMapData(map, NULL, 'removeTileLayer', layerId) } +#' @rdname remove #' @export clearTiles = function(map) { appendMapData(map, NULL, 'clearTileLayers') @@ -188,11 +213,13 @@ popupOptions = function( ) } +#' @rdname remove #' @export removePopup = function(map, layerId) { appendMapData(map, NULL, 'removePopup', layerId) } +#' @rdname remove #' @export clearPopups = function(map) { appendMapData(map, NULL, 'clearPopups') @@ -281,11 +308,13 @@ addCircleMarkers = function( expandLimits(pts$lat, pts$lng) } +#' @rdname remove #' @export removeMarker = function(map, layerId) { appendMapData(map, NULL, 'removeMarker', layerId) } +#' @rdname remove #' @export clearMarkers = function(map) { appendMapData(map, NULL, 'clearMarkers') @@ -433,11 +462,13 @@ addPolygons = function( expandLimitsBbox(pgons) } +#' @rdname remove #' @export removeShape = function(map, layerId) { appendMapData(map, NULL, 'removeShape', layerId) } +#' @rdname remove #' @export clearShapes = function(map) { appendMapData(map, NULL, 'clearShapes') diff --git a/man/map-layers.Rd b/man/map-layers.Rd index eab0febe8..3baa53905 100644 --- a/man/map-layers.Rd +++ b/man/map-layers.Rd @@ -115,6 +115,9 @@ north-east corners of rectangles} \item{geojson}{a GeoJSON list} } +\value{ +the new \code{map} object +} \description{ Add graphics elements and layers to the map widget. } diff --git a/man/remove.Rd b/man/remove.Rd new file mode 100644 index 000000000..4097aa5ed --- /dev/null +++ b/man/remove.Rd @@ -0,0 +1,55 @@ +% Please edit documentation in R/layers.R +\name{remove} +\alias{clearMarkers} +\alias{clearPopups} +\alias{clearShapes} +\alias{clearTiles} +\alias{remove} +\alias{removeMarker} +\alias{removePopup} +\alias{removeShape} +\alias{removeTiles} +\title{Remove elements from a map} +\usage{ +removeTiles(map, layerId) + +clearTiles(map) + +removePopup(map, layerId) + +clearPopups(map) + +removeMarker(map, layerId) + +clearMarkers(map) + +removeShape(map, layerId) + +clearShapes(map) +} +\arguments{ +\item{map}{a map widget object, possibly created from \code{\link{leaflet}}() +but more likely from \code{\link{getMapProxy}}()} + +\item{layerId}{character vector; the layer id(s) of the item to remove} +} +\value{ +the new \code{map} object +} +\description{ +Remove one or more features from a map, identified by \code{layerId}; or, +clear all features of the given type. +} +\note{ +When used with a \code{\link{leaflet}}() map object, these functions +don't actually remove the features from the map object, but simply add an +operation that will cause those features to be removed after they are added. +In other words, if you add a polygon \code{"foo"} and the call +\code{removeShape("foo")}, it's not smart enough to prevent the polygon from +being added in the first place; instead, when the map is rendered, the +polygon will be added and then removed. + +For that reason, these functions aren't that useful with \code{leaflet} map +objects and are really intended to be used with \code{\link{getMapProxy}} +instead. +} From 6c5b384df75fdabbe69bacad8ed5e985caa2d44e Mon Sep 17 00:00:00 2001 From: Joe Cheng Date: Fri, 24 Apr 2015 17:11:08 -0700 Subject: [PATCH 08/15] Add removeGeoJSON/clearGeoJSON --- NAMESPACE | 2 ++ R/layers.R | 12 ++++++++++++ inst/htmlwidgets/leaflet.js | 10 ++++++++++ man/remove.Rd | 6 ++++++ 4 files changed, 30 insertions(+) diff --git a/NAMESPACE b/NAMESPACE index c99d9b876..850fda08b 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -15,6 +15,7 @@ export(addPopups) export(addRectangles) export(addTiles) export(clearBounds) +export(clearGeoJSON) export(clearMarkers) export(clearPopups) export(clearShapes) @@ -34,6 +35,7 @@ export(markerOptions) export(pathOptions) export(popupOptions) export(previewColors) +export(removeGeoJSON) export(removeMarker) export(removePopup) export(removeShape) diff --git a/R/layers.R b/R/layers.R index 0cd6fccbe..d012cfcfc 100644 --- a/R/layers.R +++ b/R/layers.R @@ -480,3 +480,15 @@ clearShapes = function(map) { addGeoJSON = function(map, geojson, layerId = NULL) { appendMapData(map, getMapData(map), 'geoJSON', geojson, layerId) } + +#' @rdname remove +#' @export +removeGeoJSON = function(map, layerId) { + appendMapData(map, NULL, 'removeGeoJSON', layerId) +} + +#' @rdname remove +#' @export +clearGeoJSON = function(map) { + appendMapData(map, NULL, 'clearGeoJSON') +} diff --git a/inst/htmlwidgets/leaflet.js b/inst/htmlwidgets/leaflet.js index 83e2a88ee..18bcddaa0 100644 --- a/inst/htmlwidgets/leaflet.js +++ b/inst/htmlwidgets/leaflet.js @@ -483,6 +483,16 @@ var dataframe = (function() { this.geojson.add(gjlayer, layerId); }; + methods.removeGeoJSON = function(layerId) { + this.geojson.remove(layerId); + }; + + methods.clearGeoJSON = function() { + this.geojson.clear(); + }; + + + HTMLWidgets.widget({ name: "leaflet", type: "output", diff --git a/man/remove.Rd b/man/remove.Rd index 4097aa5ed..092592245 100644 --- a/man/remove.Rd +++ b/man/remove.Rd @@ -1,10 +1,12 @@ % Please edit documentation in R/layers.R \name{remove} +\alias{clearGeoJSON} \alias{clearMarkers} \alias{clearPopups} \alias{clearShapes} \alias{clearTiles} \alias{remove} +\alias{removeGeoJSON} \alias{removeMarker} \alias{removePopup} \alias{removeShape} @@ -26,6 +28,10 @@ clearMarkers(map) removeShape(map, layerId) clearShapes(map) + +removeGeoJSON(map, layerId) + +clearGeoJSON(map) } \arguments{ \item{map}{a map widget object, possibly created from \code{\link{leaflet}}() From 7e2de8bbd07c439ef65042444ceb1ea779b188ad Mon Sep 17 00:00:00 2001 From: Joe Cheng Date: Mon, 27 Apr 2015 15:32:06 -0700 Subject: [PATCH 09/15] Add deferUntilFlush param for getMapProxy; add docs --- R/utils.R | 28 ++++++++++++++++++++++++---- man/getMapProxy.Rd | 18 +++++++++++++++++- 2 files changed, 41 insertions(+), 5 deletions(-) diff --git a/R/utils.R b/R/utils.R index fa7f0f2c4..c93b4668b 100644 --- a/R/utils.R +++ b/R/utils.R @@ -61,6 +61,17 @@ appendMapData = function(map, data, component, ...) { #' instead of customizing an in-memory representation, these commands will #' execute on the live Leaflet map instance. #' +#' @param mapId single-element character vector indicating the output ID of the +#' map to modify +#' @param session the Shiny session object to which the map belongs; usually the +#' default value will suffice +#' @param data a data object; see Details under the \code{\link{leaflet}} help +#' topic +#' @param deferUntilFlush indicates whether actions performed against this +#' instance should be carried out right away, or whether they should be held +#' until after the next time all of the outputs are updated; defaults to +#' \code{TRUE} +#' #' @examples #' \donttest{ #' library(shiny) @@ -89,7 +100,7 @@ appendMapData = function(map, data, component, ...) { #' #' @export getMapProxy <- function(mapId, session = shiny::getDefaultReactiveDomain(), - data = NULL) { + data = NULL, deferUntilFlush = TRUE) { structure( list( session = session, @@ -97,7 +108,8 @@ getMapProxy <- function(mapId, session = shiny::getDefaultReactiveDomain(), x = structure( list(), leafletData = data - ) + ), + deferUntilFlush = deferUntilFlush ), class = "leaflet_remote" ) @@ -107,7 +119,7 @@ invokeRemote = function(map, method, args = list()) { if (!inherits(map, "leaflet_remote")) stop("Invalid map parameter; map proxy object was expected") - map$session$sendCustomMessage("leaflet-calls", list( + msg <- list( id = map$id, calls = list( list( @@ -115,7 +127,15 @@ invokeRemote = function(map, method, args = list()) { args = args ) ) - )) + ) + + if (map$deferUntilFlush) { + map$session$onFlushed(function() { + map$session$sendCustomMessage("leaflet-calls", msg) + }, once = TRUE) + } else { + map$session$sendCustomMessage("leaflet-calls", msg) + } } # A helper function to generate the body of function(x, y) list(x = x, y = y), diff --git a/man/getMapProxy.Rd b/man/getMapProxy.Rd index d5ff8eb40..d610a5e37 100644 --- a/man/getMapProxy.Rd +++ b/man/getMapProxy.Rd @@ -3,7 +3,23 @@ \alias{getMapProxy} \title{Send commands to a Leaflet instance in a Shiny app} \usage{ -getMapProxy(mapId, session = shiny::getDefaultReactiveDomain(), data = NULL) +getMapProxy(mapId, session = shiny::getDefaultReactiveDomain(), data = NULL, + deferUntilFlush = TRUE) +} +\arguments{ +\item{mapId}{single-element character vector indicating the output ID of the +map to modify} + +\item{session}{the Shiny session object to which the map belongs; usually the +default value will suffice} + +\item{data}{a data object; see Details under the \code{\link{leaflet}} help +topic} + +\item{deferUntilFlush}{indicates whether actions performed against this + instance should be carried out right away, or whether they should be held + until after the next time all of the outputs are updated; defaults to + \code{TRUE}} } \description{ Creates a map-like object that can be used to customize and control a map From dd68a6f3e0592168af46182c34edf6e320343cd0 Mon Sep 17 00:00:00 2001 From: Joe Cheng Date: Mon, 27 Apr 2015 15:48:45 -0700 Subject: [PATCH 10/15] dispatch() errors include method name --- R/layers.R | 22 +++++++++++----------- R/methods.R | 13 ++++++++----- R/utils.R | 14 ++++++++------ inst/htmlwidgets/leaflet.js | 22 +++++++++++----------- 4 files changed, 38 insertions(+), 33 deletions(-) diff --git a/R/layers.R b/R/layers.R index d012cfcfc..783d60f03 100644 --- a/R/layers.R +++ b/R/layers.R @@ -80,7 +80,7 @@ addTiles = function( '© OpenStreetMap', 'contributors, CC-BY-SA' ) - appendMapData(map, getMapData(map), 'tileLayer', urlTemplate, layerId, options) + appendMapData(map, getMapData(map), 'addTiles', urlTemplate, layerId, options) } #' Extra options for map elements and layers @@ -149,13 +149,13 @@ tileOptions = function( #' @name remove #' @export removeTiles = function(map, layerId) { - appendMapData(map, NULL, 'removeTileLayer', layerId) + appendMapData(map, NULL, 'removeTiles', layerId) } #' @rdname remove #' @export clearTiles = function(map) { - appendMapData(map, NULL, 'clearTileLayers') + appendMapData(map, NULL, 'clearTiles') } #' @param lng a numeric vector of longitudes, or a one-sided formula of the form @@ -181,7 +181,7 @@ addPopups = function( data = getMapData(map) ) { pts = derivePoints(data, lng, lat, missing(lng), missing(lat), "addPopups") - appendMapData(map, data, 'popup', pts$lat, pts$lng, popup, layerId, options) %>% + appendMapData(map, data, 'addPopups', pts$lat, pts$lng, popup, layerId, options) %>% expandLimits(pts$lat, pts$lng) } @@ -239,7 +239,7 @@ addMarkers = function( ) { options$icon = icon pts = derivePoints(data, lng, lat, missing(lng), missing(lat), "addMarkers") - appendMapData(map, data, 'marker', pts$lat, pts$lng, layerId, options, popup) %>% + appendMapData(map, data, 'addMarkers', pts$lat, pts$lng, layerId, options, popup) %>% expandLimits(pts$lat, pts$lng) } @@ -304,7 +304,7 @@ addCircleMarkers = function( dashArray = dashArray )) pts = derivePoints(data, lng, lat, missing(lng), missing(lat), "addCircleMarkers") - appendMapData(map, data, 'circleMarker', pts$lat, pts$lng, radius, layerId, options, popup) %>% + appendMapData(map, data, 'addCircleMarkers', pts$lat, pts$lng, radius, layerId, options, popup) %>% expandLimits(pts$lat, pts$lng) } @@ -366,7 +366,7 @@ addCircles = function( dashArray = dashArray )) pts = derivePoints(data, lng, lat, missing(lng), missing(lat), "addCircles") - appendMapData(map, data, 'circle', pts$lat, pts$lng, radius, layerId, options, popup) %>% + appendMapData(map, data, 'addCircles', pts$lat, pts$lng, radius, layerId, options, popup) %>% expandLimits(pts$lat, pts$lng) } @@ -397,7 +397,7 @@ addPolylines = function( dashArray = dashArray, smoothFactor = smoothFactor, noClip = noClip )) pgons = derivePolygons(data, lng, lat, missing(lng), missing(lat), "addPolylines") - appendMapData(map, data, 'polyline', pgons, layerId, options, popup) %>% + appendMapData(map, data, 'addPolylines', pgons, layerId, options, popup) %>% expandLimitsBbox(pgons) } @@ -430,7 +430,7 @@ addRectangles = function( lat1 = resolveFormula(lat1, data) lng2 = resolveFormula(lng2, data) lat2 = resolveFormula(lat2, data) - appendMapData(map, data, 'rectangle',lat1, lng1, lat2, lng2, layerId, options, popup) %>% + appendMapData(map, data, 'addRectangles',lat1, lng1, lat2, lng2, layerId, options, popup) %>% expandLimits(c(lat1, lat2), c(lng1, lng2)) } @@ -458,7 +458,7 @@ addPolygons = function( dashArray = dashArray, smoothFactor = smoothFactor, noClip = noClip )) pgons = derivePolygons(data, lng, lat, missing(lng), missing(lat), "addPolygons") - appendMapData(map, data, 'polygon', pgons, layerId, options, popup) %>% + appendMapData(map, data, 'addPolygons', pgons, layerId, options, popup) %>% expandLimitsBbox(pgons) } @@ -478,7 +478,7 @@ clearShapes = function(map) { #' @describeIn map-layers Add GeoJSON layers to the map #' @export addGeoJSON = function(map, geojson, layerId = NULL) { - appendMapData(map, getMapData(map), 'geoJSON', geojson, layerId) + appendMapData(map, getMapData(map), 'addGeoJSON', geojson, layerId) } #' @rdname remove diff --git a/R/methods.R b/R/methods.R index 0d0162dd8..88156d51f 100644 --- a/R/methods.R +++ b/R/methods.R @@ -20,12 +20,13 @@ setView = function(map, lng, lat, zoom, options = list()) { view = list(c(lat, lng), zoom, options) dispatch(map, - local = { + "setView", + leaflet = { map$x$setView = view map$x$fitBounds = NULL map }, - remote = { + leaflet_remote = { invokeRemote(map, "setView", view) map } @@ -39,12 +40,13 @@ fitBounds = function(map, lng1, lat1, lng2, lat2) { bounds = list(lat1, lng1, lat2, lng2) dispatch(map, - local = { + "fitBounds", + leaflet = { map$x$fitBounds = bounds map$x$setView = NULL map }, - remote = { + leaflet_remote = { invokeRemote(map, "fitBounds", bounds) } ) @@ -56,7 +58,8 @@ fitBounds = function(map, lng1, lat1, lng2, lat2) { #' @export clearBounds = function(map) { dispatch(map, - local = { + "clearBounds", + leaflet = { map$x$fitBounds = NULL map$x$setView = NULL map diff --git a/R/utils.R b/R/utils.R index c93b4668b..d9479555e 100644 --- a/R/utils.R +++ b/R/utils.R @@ -2,13 +2,14 @@ # depending on the type of the map object (regular or map proxy). If code was # not provided for the appropriate mode, an error will be raised. dispatch = function(map, - local = stop("Operation requires a map proxy object"), - remote = stop("Operation does not support map proxy objects") + label, + leaflet = stop(paste(label, "requires a map proxy object")), + leaflet_remote = stop(paste(label, "does not support map proxy objects")) ) { if (inherits(map, "leaflet")) - return(local) + return(leaflet) else if (inherits(map, "leaflet_remote")) - return(remote) + return(leaflet_remote) else stop("Invalid map parameter") } @@ -24,7 +25,8 @@ appendMapData = function(map, data, component, ...) { args = evalFormula(list(...), data) dispatch(map, - local = { + component, + leaflet = { x = map$x$calls if (is.null(x)) x = list() n = length(x) @@ -32,7 +34,7 @@ appendMapData = function(map, data, component, ...) { map$x$calls = x map }, - remote = { + leaflet_remote = { invokeRemote(map, method, args) map } diff --git a/inst/htmlwidgets/leaflet.js b/inst/htmlwidgets/leaflet.js index 18bcddaa0..cb43c49fa 100644 --- a/inst/htmlwidgets/leaflet.js +++ b/inst/htmlwidgets/leaflet.js @@ -242,7 +242,7 @@ var dataframe = (function() { ]); }; - methods.popup = function(lat, lng, popup, layerId, options) { + methods.addPopups = function(lat, lng, popup, layerId, options) { var df = dataframe.create() .col('lat', lat) .col('lng', lng) @@ -272,19 +272,19 @@ var dataframe = (function() { this.popups.clear(); }; - methods.tileLayer = function(urlTemplate, layerId, options) { + methods.addTiles = function(urlTemplate, layerId, options) { this.tiles.add(L.tileLayer(urlTemplate, options), layerId); }; - methods.removeTileLayer = function(layerId) { + methods.removeTiles = function(layerId) { this.tiles.remove(layerId); }; - methods.clearTileLayers = function() { + methods.clearTiles = function() { this.tiles.clear(); }; - methods.marker = function(lat, lng, layerId, options, popup) { + methods.addMarkers = function(lat, lng, layerId, options, popup) { var df = dataframe.create() .col('lat', lat) .col('lng', lng) @@ -306,7 +306,7 @@ var dataframe = (function() { } }; - methods.circle = function(lat, lng, radius, layerId, options, popup) { + methods.addCircles = function(lat, lng, radius, layerId, options, popup) { var df = dataframe.create() .col('lat', lat) .col('lng', lng) @@ -329,7 +329,7 @@ var dataframe = (function() { } }; - methods.circleMarker = function(lat, lng, radius, layerId, options, popup) { + methods.addCircleMarkers = function(lat, lng, radius, layerId, options, popup) { var df = dataframe.create() .col('lat', lat) .col('lng', lng) @@ -356,7 +356,7 @@ var dataframe = (function() { * @param lat Array of arrays of latitude coordinates for polylines * @param lng Array of arrays of longitude coordinates for polylines */ - methods.polyline = function(polygons, layerId, options, popup) { + methods.addPolylines = function(polygons, layerId, options, popup) { var df = dataframe.create() .col('shapes', polygons) .col('layerId', layerId) @@ -395,7 +395,7 @@ var dataframe = (function() { this.shapes.clear(); }; - methods.rectangle = function(lat1, lng1, lat2, lng2, layerId, options, popup) { + methods.addRectangles = function(lat1, lng1, lat2, lng2, layerId, options, popup) { var df = dataframe.create() .col('lat1', lat1) .col('lng1', lng1) @@ -427,7 +427,7 @@ var dataframe = (function() { * @param lat Array of arrays of latitude coordinates for polygons * @param lng Array of arrays of longitude coordinates for polygons */ - methods.polygon = function(polygons, layerId, options, popup) { + methods.addPolygons = function(polygons, layerId, options, popup) { var df = dataframe.create() .col('shapes', polygons) .col('layerId', layerId) @@ -452,7 +452,7 @@ var dataframe = (function() { } }; - methods.geoJSON = function(data, layerId) { + methods.addGeoJSON = function(data, layerId) { var self = this; if (typeof(data) === "string") { data = JSON.parse(data); From 361485efa042572083bae7f362b3357c25498a53 Mon Sep 17 00:00:00 2001 From: Joe Cheng Date: Mon, 27 Apr 2015 16:39:31 -0700 Subject: [PATCH 11/15] Rename appendMapData to invokeMethod; export, add docs --- NAMESPACE | 2 ++ R/layers.R | 38 +++++++++++++++++++------------------- R/utils.R | 36 +++++++++++++++++++++++++++++------- man/dispatch.Rd | 39 +++++++++++++++++++++++++++++++++++++++ 4 files changed, 89 insertions(+), 26 deletions(-) create mode 100644 man/dispatch.Rd diff --git a/NAMESPACE b/NAMESPACE index 850fda08b..e7ee570d2 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -25,8 +25,10 @@ export(colorFactor) export(colorNumeric) export(colorQuantile) export(createLeafletMap) +export(dispatch) export(fitBounds) export(getMapProxy) +export(invokeMethod) export(leaflet) export(leafletMap) export(leafletOutput) diff --git a/R/layers.R b/R/layers.R index 783d60f03..3d5f49dc1 100644 --- a/R/layers.R +++ b/R/layers.R @@ -80,7 +80,7 @@ addTiles = function( '© OpenStreetMap', 'contributors, CC-BY-SA' ) - appendMapData(map, getMapData(map), 'addTiles', urlTemplate, layerId, options) + invokeMethod(map, getMapData(map), 'addTiles', urlTemplate, layerId, options) } #' Extra options for map elements and layers @@ -149,13 +149,13 @@ tileOptions = function( #' @name remove #' @export removeTiles = function(map, layerId) { - appendMapData(map, NULL, 'removeTiles', layerId) + invokeMethod(map, NULL, 'removeTiles', layerId) } #' @rdname remove #' @export clearTiles = function(map) { - appendMapData(map, NULL, 'clearTiles') + invokeMethod(map, NULL, 'clearTiles') } #' @param lng a numeric vector of longitudes, or a one-sided formula of the form @@ -181,7 +181,7 @@ addPopups = function( data = getMapData(map) ) { pts = derivePoints(data, lng, lat, missing(lng), missing(lat), "addPopups") - appendMapData(map, data, 'addPopups', pts$lat, pts$lng, popup, layerId, options) %>% + invokeMethod(map, data, 'addPopups', pts$lat, pts$lng, popup, layerId, options) %>% expandLimits(pts$lat, pts$lng) } @@ -216,13 +216,13 @@ popupOptions = function( #' @rdname remove #' @export removePopup = function(map, layerId) { - appendMapData(map, NULL, 'removePopup', layerId) + invokeMethod(map, NULL, 'removePopup', layerId) } #' @rdname remove #' @export clearPopups = function(map) { - appendMapData(map, NULL, 'clearPopups') + invokeMethod(map, NULL, 'clearPopups') } #' @param icon the icon for markers; if you want to create a new icon using @@ -239,7 +239,7 @@ addMarkers = function( ) { options$icon = icon pts = derivePoints(data, lng, lat, missing(lng), missing(lat), "addMarkers") - appendMapData(map, data, 'addMarkers', pts$lat, pts$lng, layerId, options, popup) %>% + invokeMethod(map, data, 'addMarkers', pts$lat, pts$lng, layerId, options, popup) %>% expandLimits(pts$lat, pts$lng) } @@ -304,20 +304,20 @@ addCircleMarkers = function( dashArray = dashArray )) pts = derivePoints(data, lng, lat, missing(lng), missing(lat), "addCircleMarkers") - appendMapData(map, data, 'addCircleMarkers', pts$lat, pts$lng, radius, layerId, options, popup) %>% + invokeMethod(map, data, 'addCircleMarkers', pts$lat, pts$lng, radius, layerId, options, popup) %>% expandLimits(pts$lat, pts$lng) } #' @rdname remove #' @export removeMarker = function(map, layerId) { - appendMapData(map, NULL, 'removeMarker', layerId) + invokeMethod(map, NULL, 'removeMarker', layerId) } #' @rdname remove #' @export clearMarkers = function(map) { - appendMapData(map, NULL, 'clearMarkers') + invokeMethod(map, NULL, 'clearMarkers') } #' @param lineCap a string that defines @@ -366,7 +366,7 @@ addCircles = function( dashArray = dashArray )) pts = derivePoints(data, lng, lat, missing(lng), missing(lat), "addCircles") - appendMapData(map, data, 'addCircles', pts$lat, pts$lng, radius, layerId, options, popup) %>% + invokeMethod(map, data, 'addCircles', pts$lat, pts$lng, radius, layerId, options, popup) %>% expandLimits(pts$lat, pts$lng) } @@ -397,7 +397,7 @@ addPolylines = function( dashArray = dashArray, smoothFactor = smoothFactor, noClip = noClip )) pgons = derivePolygons(data, lng, lat, missing(lng), missing(lat), "addPolylines") - appendMapData(map, data, 'addPolylines', pgons, layerId, options, popup) %>% + invokeMethod(map, data, 'addPolylines', pgons, layerId, options, popup) %>% expandLimitsBbox(pgons) } @@ -430,7 +430,7 @@ addRectangles = function( lat1 = resolveFormula(lat1, data) lng2 = resolveFormula(lng2, data) lat2 = resolveFormula(lat2, data) - appendMapData(map, data, 'addRectangles',lat1, lng1, lat2, lng2, layerId, options, popup) %>% + invokeMethod(map, data, 'addRectangles',lat1, lng1, lat2, lng2, layerId, options, popup) %>% expandLimits(c(lat1, lat2), c(lng1, lng2)) } @@ -458,37 +458,37 @@ addPolygons = function( dashArray = dashArray, smoothFactor = smoothFactor, noClip = noClip )) pgons = derivePolygons(data, lng, lat, missing(lng), missing(lat), "addPolygons") - appendMapData(map, data, 'addPolygons', pgons, layerId, options, popup) %>% + invokeMethod(map, data, 'addPolygons', pgons, layerId, options, popup) %>% expandLimitsBbox(pgons) } #' @rdname remove #' @export removeShape = function(map, layerId) { - appendMapData(map, NULL, 'removeShape', layerId) + invokeMethod(map, NULL, 'removeShape', layerId) } #' @rdname remove #' @export clearShapes = function(map) { - appendMapData(map, NULL, 'clearShapes') + invokeMethod(map, NULL, 'clearShapes') } #' @param geojson a GeoJSON list #' @describeIn map-layers Add GeoJSON layers to the map #' @export addGeoJSON = function(map, geojson, layerId = NULL) { - appendMapData(map, getMapData(map), 'addGeoJSON', geojson, layerId) + invokeMethod(map, getMapData(map), 'addGeoJSON', geojson, layerId) } #' @rdname remove #' @export removeGeoJSON = function(map, layerId) { - appendMapData(map, NULL, 'removeGeoJSON', layerId) + invokeMethod(map, NULL, 'removeGeoJSON', layerId) } #' @rdname remove #' @export clearGeoJSON = function(map) { - appendMapData(map, NULL, 'clearGeoJSON') + invokeMethod(map, NULL, 'clearGeoJSON') } diff --git a/R/utils.R b/R/utils.R index d9479555e..7ef6b55b0 100644 --- a/R/utils.R +++ b/R/utils.R @@ -1,10 +1,27 @@ # Given a local and/or remote operation and a map, execute one or the other # depending on the type of the map object (regular or map proxy). If code was # not provided for the appropriate mode, an error will be raised. + +#' Extension points for plugins +#' +#' @param map a map object, as returned from \code{\link{leaflet}} or +#' \code{\link{getMapProxy}} +#' @param funcName the name of the function that the user called that caused +#' this \code{dispatch} call; for error message purposes +#' @param leaflet an action to be performed if the map is from +#' \code{\link{leaflet}} +#' @param leaflet_remote an action to be performed if the map is from +#' \code{\link{getMapProxy}} +#' +#' @return \code{dispatch} returns the value of \code{leaflet} or +#' \code{leaflet_remote}, or an error. \code{invokeMethod} returns the +#' \code{map} object that was passed in, possibly modified. +#' +#' @export dispatch = function(map, - label, - leaflet = stop(paste(label, "requires a map proxy object")), - leaflet_remote = stop(paste(label, "does not support map proxy objects")) + funcName, + leaflet = stop(paste(funcName, "requires a map proxy object")), + leaflet_remote = stop(paste(funcName, "does not support map proxy objects")) ) { if (inherits(map, "leaflet")) return(leaflet) @@ -20,17 +37,22 @@ filterNULL = function(x) { x[!unlist(lapply(x, is.null))] } -appendMapData = function(map, data, component, ...) { - method = component +#' @param data a data object that will be used when evaluating formulas in +#' \code{...} +#' @param method the name of the JavaScript method to invoke +#' @param ... unnamed arguments to be passed to the JavaScript method +#' @rdname dispatch +#' @export +invokeMethod = function(map, data, method, ...) { args = evalFormula(list(...), data) dispatch(map, - component, + method, leaflet = { x = map$x$calls if (is.null(x)) x = list() n = length(x) - x[[n + 1]] = list(method = component, args = args) + x[[n + 1]] = list(method = method, args = args) map$x$calls = x map }, diff --git a/man/dispatch.Rd b/man/dispatch.Rd new file mode 100644 index 000000000..eafc5c779 --- /dev/null +++ b/man/dispatch.Rd @@ -0,0 +1,39 @@ +% Please edit documentation in R/utils.R +\name{dispatch} +\alias{dispatch} +\alias{invokeMethod} +\title{Extension points for plugins} +\usage{ +dispatch(map, funcName, leaflet = stop(paste(funcName, "requires a map proxy object")), + leaflet_remote = stop(paste(funcName, "does not support map proxy objects"))) + +invokeMethod(map, data, method, ...) +} +\arguments{ +\item{map}{a map object, as returned from \code{\link{leaflet}} or +\code{\link{getMapProxy}}} + +\item{funcName}{the name of the function that the user called that caused +this \code{dispatch} call; for error message purposes} + +\item{leaflet}{an action to be performed if the map is from +\code{\link{leaflet}}} + +\item{leaflet_remote}{an action to be performed if the map is from + \code{\link{getMapProxy}}} + +\item{data}{a data object that will be used when evaluating formulas in +\code{...}} + +\item{method}{the name of the JavaScript method to invoke} + +\item{...}{unnamed arguments to be passed to the JavaScript method} +} +\value{ +\code{dispatch} returns the value of \code{leaflet} or + \code{leaflet_remote}, or an error. \code{invokeMethod} returns the + \code{map} object that was passed in, possibly modified. +} +\description{ +Extension points for plugins +} From 55a9d265ea8caf831099fa25ea0131a9a1f24b9b Mon Sep 17 00:00:00 2001 From: Joe Cheng Date: Tue, 28 Apr 2015 09:47:07 -0700 Subject: [PATCH 12/15] Add tests for Shiny interaction --- DESCRIPTION | 3 +- tests/testit/test-remote.R | 156 +++++++++++++++++++++++++++++++++++++ 2 files changed, 158 insertions(+), 1 deletion(-) create mode 100644 tests/testit/test-remote.R diff --git a/DESCRIPTION b/DESCRIPTION index 4bb1a456a..6aa0cb98b 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -31,5 +31,6 @@ Suggests: maps, shiny, sp, - testit + testit, + R6 VignetteBuilder: knitr diff --git a/tests/testit/test-remote.R b/tests/testit/test-remote.R new file mode 100644 index 000000000..4583a796f --- /dev/null +++ b/tests/testit/test-remote.R @@ -0,0 +1,156 @@ +library(testit) +library(R6) + +# This class is copied from Shiny +Map <- R6Class( + 'Map', + portable = FALSE, + public = list( + initialize = function() { + private$env <- new.env(parent=emptyenv()) + }, + get = function(key) { + env[[key]] + }, + set = function(key, value) { + env[[key]] <- value + value + }, + mset = function(...) { + args <- list(...) + if (length(args) == 0) + return() + + arg_names <- names(args) + if (is.null(arg_names) || any(!nzchar(arg_names))) + stop("All elements must be named") + + list2env(args, envir = env) + }, + remove = function(key) { + if (!self$containsKey(key)) + return(NULL) + + result <- env[[key]] + rm(list=key, envir=env, inherits=FALSE) + result + }, + containsKey = function(key) { + exists(key, envir=env, inherits=FALSE) + }, + keys = function() { + # Sadly, this is much faster than ls(), because it doesn't sort the keys. + names(as.list(env, all.names=TRUE)) + }, + values = function() { + as.list(env, all.names=TRUE) + }, + clear = function() { + private$env <- new.env(parent=emptyenv()) + invisible(NULL) + }, + size = function() { + length(env) + } + ), + + private = list( + env = 'environment' + ) +) + + +# This class is copied from Shiny +Callbacks <- R6Class( + 'Callbacks', + portable = FALSE, + class = FALSE, + public = list( + .nextId = integer(0), + .callbacks = 'Map', + + initialize = function() { + .nextId <<- as.integer(.Machine$integer.max) + .callbacks <<- Map$new() + }, + register = function(callback) { + id <- as.character(.nextId) + .nextId <<- .nextId - 1L + .callbacks$set(id, callback) + return(function() { + .callbacks$remove(id) + }) + }, + invoke = function(..., onError=NULL) { + for (callback in .callbacks$values()) { + if (is.null(onError)) { + callback(...) + } else { + tryCatch(callback(...), error = onError) + } + } + }, + count = function() { + .callbacks$size() + } + ) +) + + +MockSession <- R6Class("MockSession", + public = list( + sendCustomMessage = function(type, message) { + self$.calls <- c(self$.calls, list(list( + type = type, + message = shiny:::toJSON(message) + ))) + }, + onFlushed = function(func, once = TRUE) { + unregister <- private$flushCallbacks$register(function(...) { + func(...) + if (once) + unregister() + }) + }, + .flush = function() { + private$flushCallbacks$invoke() + }, + .calls = list() + ), + private = list( + flushCallbacks = Callbacks$new() + ) +) + + +local <- leaflet() + +mockSession <- MockSession$new() +remote <- getMapProxy("map", mockSession) + +remote %>% addPolygons(lng=1:5, lat=1:5) + +# Check that remote functions only get invoked after flush, by default +assert(identical(mockSession$.calls, list())) +mockSession$.flush() +expected <- list( + list(type = "leaflet-calls", message = structure("{\"id\":\"map\",\"calls\":[{\"method\":\"addPolygons\",\"args\":[[[{\"lng\":[1,2,3,4,5],\"lat\":[1,2,3,4,5]}]],null,{\"lineCap\":null,\"lineJoin\":null,\"clickable\":true,\"pointerEvents\":null,\"className\":\"\",\"stroke\":true,\"color\":\"#03F\",\"weight\":5,\"opacity\":0.5,\"fill\":true,\"fillColor\":\"#03F\",\"fillOpacity\":0.2,\"dashArray\":null,\"smoothFactor\":1,\"noClip\":false},null]}]}", class = "json")) +) +assert(identical(mockSession$.calls, expected)) + + +# Reset mock session +mockSession$.calls <- list() + +# Create another remote map which doesn't wait until flush +remote2 <- getMapProxy("map", mockSession, + data.frame(lat=10:1, lng=10:1), + deferUntilFlush = FALSE +) +# Check that addMarkers() takes effect immediately, no flush required +remote2 %>% addMarkers() +expected <- list(list(type = "leaflet-calls", message = structure("{\"id\":\"map\",\"calls\":[{\"method\":\"addMarkers\",\"args\":[[10,9,8,7,6,5,4,3,2,1],[10,9,8,7,6,5,4,3,2,1],null,{\"clickable\":true,\"draggable\":false,\"keyboard\":true,\"title\":\"\",\"alt\":\"\",\"zIndexOffset\":0,\"opacity\":1,\"riseOnHover\":false,\"riseOffset\":250},null]}]}", class = "json"))) +assert(identical(mockSession$.calls, expected)) +# Flushing should do nothing +mockSession$.flush() +assert(identical(mockSession$.calls, expected)) From 0655ed57076c6d123b78670e044f598c23d911f2 Mon Sep 17 00:00:00 2001 From: Joe Cheng Date: Tue, 28 Apr 2015 10:26:18 -0700 Subject: [PATCH 13/15] Rename getMapProxy to leafletProxy --- NAMESPACE | 2 +- R/layers.R | 4 ++-- R/utils.R | 10 +++++----- inst/examples/shiny.R | 4 ++-- man/dispatch.Rd | 4 ++-- man/{getMapProxy.Rd => leafletProxy.Rd} | 10 +++++----- man/remove.Rd | 4 ++-- tests/testit/test-remote.R | 4 ++-- 8 files changed, 21 insertions(+), 21 deletions(-) rename man/{getMapProxy.Rd => leafletProxy.Rd} (88%) diff --git a/NAMESPACE b/NAMESPACE index e7ee570d2..950002b4c 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -27,11 +27,11 @@ export(colorQuantile) export(createLeafletMap) export(dispatch) export(fitBounds) -export(getMapProxy) export(invokeMethod) export(leaflet) export(leafletMap) export(leafletOutput) +export(leafletProxy) export(mapOptions) export(markerOptions) export(pathOptions) diff --git a/R/layers.R b/R/layers.R index 3d5f49dc1..ff3e8010a 100644 --- a/R/layers.R +++ b/R/layers.R @@ -138,11 +138,11 @@ tileOptions = function( #' polygon will be added and then removed. #' #' For that reason, these functions aren't that useful with \code{leaflet} map -#' objects and are really intended to be used with \code{\link{getMapProxy}} +#' objects and are really intended to be used with \code{\link{leafletProxy}} #' instead. #' #' @param map a map widget object, possibly created from \code{\link{leaflet}}() -#' but more likely from \code{\link{getMapProxy}}() +#' but more likely from \code{\link{leafletProxy}}() #' @param layerId character vector; the layer id(s) of the item to remove #' @return the new \code{map} object #' diff --git a/R/utils.R b/R/utils.R index 7ef6b55b0..0b9ea0197 100644 --- a/R/utils.R +++ b/R/utils.R @@ -5,13 +5,13 @@ #' Extension points for plugins #' #' @param map a map object, as returned from \code{\link{leaflet}} or -#' \code{\link{getMapProxy}} +#' \code{\link{leafletProxy}} #' @param funcName the name of the function that the user called that caused #' this \code{dispatch} call; for error message purposes #' @param leaflet an action to be performed if the map is from #' \code{\link{leaflet}} #' @param leaflet_remote an action to be performed if the map is from -#' \code{\link{getMapProxy}} +#' \code{\link{leafletProxy}} #' #' @return \code{dispatch} returns the value of \code{leaflet} or #' \code{leaflet_remote}, or an error. \code{invokeMethod} returns the @@ -79,7 +79,7 @@ invokeMethod = function(map, data, method, ...) { #' map is long gone, and the user's web browser has already realized the Leaflet #' map instance. #' -#' This is where \code{getMapProxy} comes in. It returns an object that can +#' This is where \code{leafletProxy} comes in. It returns an object that can #' stand in for the usual Leaflet map object. The usual map functions like #' \code{\link{addPolygons}} and \code{\link{setView}} can be called, and #' instead of customizing an in-memory representation, these commands will @@ -113,7 +113,7 @@ invokeMethod = function(map, data, method, ...) { #' }) #' #' observeEvent(input$map1_marker_click, { -#' getMapProxy("map1", session) %>% +#' leafletProxy("map1", session) %>% #' removeMarker(input$map1_marker_click$id) #' }) #' } @@ -123,7 +123,7 @@ invokeMethod = function(map, data, method, ...) { #' } #' #' @export -getMapProxy <- function(mapId, session = shiny::getDefaultReactiveDomain(), +leafletProxy <- function(mapId, session = shiny::getDefaultReactiveDomain(), data = NULL, deferUntilFlush = TRUE) { structure( list( diff --git a/inst/examples/shiny.R b/inst/examples/shiny.R index d1be1caae..143352721 100644 --- a/inst/examples/shiny.R +++ b/inst/examples/shiny.R @@ -41,7 +41,7 @@ server <- function(input, output, session) { observeEvent(input$map1_click, { v$msg <- paste("Clicked map at", input$map1_click$lat, "/", input$map1_click$lng) if (input$addMarker) { - getMapProxy("map1") %>% + leafletProxy("map1") %>% addMarkers(lng = input$map1_click$lng, lat = input$map1_click$lat) } }) @@ -52,7 +52,7 @@ server <- function(input, output, session) { v$msg <- paste("Bounds changed to", paste(input$map1_bounds, collapse = ", ")) }) observeEvent(input$clearMarkers, { - getMapProxy("map1") %>% clearMarkers() + leafletProxy("map1") %>% clearMarkers() }) output$message <- renderText(v$msg) diff --git a/man/dispatch.Rd b/man/dispatch.Rd index eafc5c779..1b4fedd8e 100644 --- a/man/dispatch.Rd +++ b/man/dispatch.Rd @@ -11,7 +11,7 @@ invokeMethod(map, data, method, ...) } \arguments{ \item{map}{a map object, as returned from \code{\link{leaflet}} or -\code{\link{getMapProxy}}} +\code{\link{leafletProxy}}} \item{funcName}{the name of the function that the user called that caused this \code{dispatch} call; for error message purposes} @@ -20,7 +20,7 @@ this \code{dispatch} call; for error message purposes} \code{\link{leaflet}}} \item{leaflet_remote}{an action to be performed if the map is from - \code{\link{getMapProxy}}} + \code{\link{leafletProxy}}} \item{data}{a data object that will be used when evaluating formulas in \code{...}} diff --git a/man/getMapProxy.Rd b/man/leafletProxy.Rd similarity index 88% rename from man/getMapProxy.Rd rename to man/leafletProxy.Rd index d610a5e37..e756f3750 100644 --- a/man/getMapProxy.Rd +++ b/man/leafletProxy.Rd @@ -1,9 +1,9 @@ % Please edit documentation in R/utils.R -\name{getMapProxy} -\alias{getMapProxy} +\name{leafletProxy} +\alias{leafletProxy} \title{Send commands to a Leaflet instance in a Shiny app} \usage{ -getMapProxy(mapId, session = shiny::getDefaultReactiveDomain(), data = NULL, +leafletProxy(mapId, session = shiny::getDefaultReactiveDomain(), data = NULL, deferUntilFlush = TRUE) } \arguments{ @@ -37,7 +37,7 @@ is rendered to an output. At this point, the in-memory representation of the map is long gone, and the user's web browser has already realized the Leaflet map instance. -This is where \code{getMapProxy} comes in. It returns an object that can +This is where \code{leafletProxy} comes in. It returns an object that can stand in for the usual Leaflet map object. The usual map functions like \code{\link{addPolygons}} and \code{\link{setView}} can be called, and instead of customizing an in-memory representation, these commands will @@ -56,7 +56,7 @@ server <- function(input, output, session) { }) observeEvent(input$map1_marker_click, { - getMapProxy("map1", session) \%>\% removeMarker(input$map1_marker_click$id) + leafletProxy("map1", session) \%>\% removeMarker(input$map1_marker_click$id) }) } diff --git a/man/remove.Rd b/man/remove.Rd index 092592245..60fc82ff0 100644 --- a/man/remove.Rd +++ b/man/remove.Rd @@ -35,7 +35,7 @@ clearGeoJSON(map) } \arguments{ \item{map}{a map widget object, possibly created from \code{\link{leaflet}}() -but more likely from \code{\link{getMapProxy}}()} +but more likely from \code{\link{leafletProxy}}()} \item{layerId}{character vector; the layer id(s) of the item to remove} } @@ -56,6 +56,6 @@ being added in the first place; instead, when the map is rendered, the polygon will be added and then removed. For that reason, these functions aren't that useful with \code{leaflet} map -objects and are really intended to be used with \code{\link{getMapProxy}} +objects and are really intended to be used with \code{\link{leafletProxy}} instead. } diff --git a/tests/testit/test-remote.R b/tests/testit/test-remote.R index 4583a796f..4271bc401 100644 --- a/tests/testit/test-remote.R +++ b/tests/testit/test-remote.R @@ -126,7 +126,7 @@ MockSession <- R6Class("MockSession", local <- leaflet() mockSession <- MockSession$new() -remote <- getMapProxy("map", mockSession) +remote <- leafletProxy("map", mockSession) remote %>% addPolygons(lng=1:5, lat=1:5) @@ -143,7 +143,7 @@ assert(identical(mockSession$.calls, expected)) mockSession$.calls <- list() # Create another remote map which doesn't wait until flush -remote2 <- getMapProxy("map", mockSession, +remote2 <- leafletProxy("map", mockSession, data.frame(lat=10:1, lng=10:1), deferUntilFlush = FALSE ) From baa2bc25386f2a20e33fc8984a1096165711c544 Mon Sep 17 00:00:00 2001 From: Joe Cheng Date: Tue, 28 Apr 2015 10:27:56 -0700 Subject: [PATCH 14/15] Change internal references to leaflet_remote to leaflet_proxy --- R/methods.R | 4 ++-- R/utils.R | 16 ++++++++-------- man/dispatch.Rd | 6 +++--- 3 files changed, 13 insertions(+), 13 deletions(-) diff --git a/R/methods.R b/R/methods.R index 88156d51f..bb4a3b9c5 100644 --- a/R/methods.R +++ b/R/methods.R @@ -26,7 +26,7 @@ setView = function(map, lng, lat, zoom, options = list()) { map$x$fitBounds = NULL map }, - leaflet_remote = { + leaflet_proxy = { invokeRemote(map, "setView", view) map } @@ -46,7 +46,7 @@ fitBounds = function(map, lng1, lat1, lng2, lat2) { map$x$setView = NULL map }, - leaflet_remote = { + leaflet_proxy = { invokeRemote(map, "fitBounds", bounds) } ) diff --git a/R/utils.R b/R/utils.R index 0b9ea0197..6bbe67c12 100644 --- a/R/utils.R +++ b/R/utils.R @@ -10,23 +10,23 @@ #' this \code{dispatch} call; for error message purposes #' @param leaflet an action to be performed if the map is from #' \code{\link{leaflet}} -#' @param leaflet_remote an action to be performed if the map is from +#' @param leaflet_proxy an action to be performed if the map is from #' \code{\link{leafletProxy}} #' #' @return \code{dispatch} returns the value of \code{leaflet} or -#' \code{leaflet_remote}, or an error. \code{invokeMethod} returns the +#' \code{leaflet_proxy}, or an error. \code{invokeMethod} returns the #' \code{map} object that was passed in, possibly modified. #' #' @export dispatch = function(map, funcName, leaflet = stop(paste(funcName, "requires a map proxy object")), - leaflet_remote = stop(paste(funcName, "does not support map proxy objects")) + leaflet_proxy = stop(paste(funcName, "does not support map proxy objects")) ) { if (inherits(map, "leaflet")) return(leaflet) - else if (inherits(map, "leaflet_remote")) - return(leaflet_remote) + else if (inherits(map, "leaflet_proxy")) + return(leaflet_proxy) else stop("Invalid map parameter") } @@ -56,7 +56,7 @@ invokeMethod = function(map, data, method, ...) { map$x$calls = x map }, - leaflet_remote = { + leaflet_proxy = { invokeRemote(map, method, args) map } @@ -135,12 +135,12 @@ leafletProxy <- function(mapId, session = shiny::getDefaultReactiveDomain(), ), deferUntilFlush = deferUntilFlush ), - class = "leaflet_remote" + class = "leaflet_proxy" ) } invokeRemote = function(map, method, args = list()) { - if (!inherits(map, "leaflet_remote")) + if (!inherits(map, "leaflet_proxy")) stop("Invalid map parameter; map proxy object was expected") msg <- list( diff --git a/man/dispatch.Rd b/man/dispatch.Rd index 1b4fedd8e..0034e4842 100644 --- a/man/dispatch.Rd +++ b/man/dispatch.Rd @@ -5,7 +5,7 @@ \title{Extension points for plugins} \usage{ dispatch(map, funcName, leaflet = stop(paste(funcName, "requires a map proxy object")), - leaflet_remote = stop(paste(funcName, "does not support map proxy objects"))) + leaflet_proxy = stop(paste(funcName, "does not support map proxy objects"))) invokeMethod(map, data, method, ...) } @@ -19,7 +19,7 @@ this \code{dispatch} call; for error message purposes} \item{leaflet}{an action to be performed if the map is from \code{\link{leaflet}}} -\item{leaflet_remote}{an action to be performed if the map is from +\item{leaflet_proxy}{an action to be performed if the map is from \code{\link{leafletProxy}}} \item{data}{a data object that will be used when evaluating formulas in @@ -31,7 +31,7 @@ this \code{dispatch} call; for error message purposes} } \value{ \code{dispatch} returns the value of \code{leaflet} or - \code{leaflet_remote}, or an error. \code{invokeMethod} returns the + \code{leaflet_proxy}, or an error. \code{invokeMethod} returns the \code{map} object that was passed in, possibly modified. } \description{ From e7ed5f03fd948081ba41ed5e2c267269586454a9 Mon Sep 17 00:00:00 2001 From: Joe Cheng Date: Tue, 28 Apr 2015 10:37:05 -0700 Subject: [PATCH 15/15] Suppress expected warnings, messages in tests --- tests/testit/test-colors.R | 2 ++ tests/testit/test-normalize.R | 2 +- 2 files changed, 3 insertions(+), 1 deletion(-) diff --git a/tests/testit/test-colors.R b/tests/testit/test-colors.R index 4f73090bb..44bc18d16 100644 --- a/tests/testit/test-colors.R +++ b/tests/testit/test-colors.R @@ -10,6 +10,7 @@ assert( ) # Outside of domain? Return na.color +suppressWarnings( assert( identical("#808080", colorFactor(bw, letters)("foo")), identical("#808080", colorQuantile(bw, 0:1)(-1)), @@ -28,6 +29,7 @@ assert( has_warning(colorNumeric(bw, c(0, 1), na.color = NA)(2)), TRUE ) +) assert( identical( diff --git a/tests/testit/test-normalize.R b/tests/testit/test-normalize.R index b4250ca9e..1c67e0816 100644 --- a/tests/testit/test-normalize.R +++ b/tests/testit/test-normalize.R @@ -8,7 +8,7 @@ assert( identical(guessLL(c('lat', 'long')), list(lng = 'long', lat = 'lat')), identical(guessLL(c('latitude', 'lng')), list(lng = 'lng', lat = 'latitude')), identical(guessLL(c('Latitude', 'Long')), list(lng = 'Long', lat = 'Latitude')), - identical(guessLL(c('Lat', 'lng', 'latt')), list(lng = 'lng', lat = 'Lat')), + identical(suppressMessages(guessLL(c('Lat', 'lng', 'latt'))), list(lng = 'lng', lat = 'Lat')), identical(guessLL(c('Lat', 'foo'), stopOnFailure = FALSE), list(lng = NA, lat = NA)), TRUE )