version 0.6 combining changes from multiple pull requests

DESCRIPTION

@@ -2,12 +2,14 @@ Package: mapedit
 Title: Interactive Editing of Spatial Data in R
 Description: Suite of interactive functions and helpers for selecting and editing
     geospatial data.
-Version: 0.5.0
-Date: 2019-03-16
+Version: 0.6.0
+Date: 2019-07-16
 Authors@R: c(
     person("Tim", "Appelhans", role = c("aut", "cre"), email = "[email protected]"),
     person("Kenton", "Russell", role = c("aut")),
-    person("Lorenzo", "Busetto", role = c("aut"))
+    person("Lorenzo", "Busetto", role = c("aut")),
+    person("Josh", "O'Brien", role = c("ctb")),
+    person("Jakob", "Gutschlhofer", role = c("aut"))
   )
 URL: https://github.com/r-spatial/mapedit
 BugReports: https://github.com/r-spatial/mapedit/issues

R/addToolbar.R

@@ -0,0 +1,110 @@
+
+
+##' @title Prepare arguments for addDrawToolbar or addPmToolbar
+##' @param fun Function used by editor package (leafpm or
+##'     leaflet.extras) to set defaults
+##' @param args Either a (possibly nested) list of named options of
+##'     the form suitable for passage to \code{fun} or (if the chosen
+##'     editor is \code{"leaflet.extras"}) \code{FALSE}.
+##' @return An object suitable for passing in as the supplied argument
+##'     to either \code{leaflet.extras::addDrawToolbar} or
+##'     \code{leafpm::addPmToolbar}.
+processOpts <- function(fun, args) {
+    ## Account for special meaning of `FALSE` as arg in leaflet.extras
+    if(identical(args, FALSE)) {
+        return(FALSE)
+    } else {
+        return(do.call(fun, args))
+    }
+}
+
+
+##' @title Add a (possibly customized) toolbar to a leaflet map
+##' @param leafmap leaflet map to use for Selection
+##' @param editorOptions A list of options to be passed on to either
+##'     \code{leaflet.extras::addDrawToolbar} or
+##'     \code{leafpm::addPmToolbar}.
+##' @param editor Character string giving editor to be used for the
+##'     current map. Either \code{"leafpm"} or
+##'     \code{"leaflet.extras"}.
+##' @param targetLayerId \code{string} name of the map layer group to
+##'     use with edit
+##' @return The leaflet map supplied to \code{leafmap}, now with an
+##'     added toolbar.
+addToolbar <- function(leafmap, editorOptions, editor,
+                       targetLayerId) {
+    ## Set up this package's defaults
+    if (editor == "leafpm") {
+        if(any(sapply(leafmap$x$calls, "[[", "method") %in%
+               c("addPolylines", "addPolygons"))) {
+            editorDefaults <-
+                list(toolbarOptions = list(drawCircle = FALSE),
+                     drawOptions = list(allowSelfIntersection = FALSE),
+                     editOptions = list(allowSelfIntersection = FALSE),
+                     cutOptions = list(allowSelfIntersection = FALSE))
+        } else {
+            editorDefaults <-
+                list(toolbarOptions = list(drawCircle = FALSE),
+                     drawOptions = list(),
+                     editOptions = list(),
+                     cutOptions = list())
+        }
+    }
+    if (editor == "leaflet.extras") {
+        editorDefaults <-
+            list(polylineOptions = list(repeatMode = TRUE),
+                 polygonOptions = list(repeatMode = TRUE),
+                 circleOptions = FALSE,
+                 rectangleOptions = list(repeatMode = TRUE),
+                 markerOptions = list(repeatMode = TRUE),
+                 circleMarkerOptions = list(repeatMode = TRUE),
+                 editOptions = list())
+    }
+
+    ## Apply user-supplied options, if any
+    editorArgs <- utils::modifyList(editorDefaults, editorOptions)
+
+
+    ## Add toolbar to leafmap object
+    if (editor == "leaflet.extras") {
+        leaflet.extras::addDrawToolbar(
+          leafmap,
+          targetGroup = targetLayerId,
+          polylineOptions =
+              processOpts(leaflet.extras::drawPolylineOptions,
+                          editorArgs[["polylineOptions"]]),
+          polygonOptions =
+              processOpts(leaflet.extras::drawPolygonOptions,
+                          editorArgs[["polygonOptions"]]),
+          circleOptions =
+              processOpts(leaflet.extras::drawCircleOptions,
+                          editorArgs[["circleOptions"]]),
+          rectangleOptions =
+              processOpts(leaflet.extras::drawRectangleOptions,
+                          editorArgs[["rectangleOptions"]]),
+          markerOptions =
+              processOpts(leaflet.extras::drawMarkerOptions,
+                             editorArgs[["markerOptions"]]),
+          circleMarkerOptions =
+              processOpts(leaflet.extras::drawCircleMarkerOptions,
+                          editorArgs[["circleMarkerOptions"]]),
+          editOptions =
+              processOpts(leaflet.extras::editToolbarOptions,
+                          editorArgs[["editOptions"]])
+          )
+    } else if (editor == "leafpm") {
+        leafpm::addPmToolbar(
+          leafmap,
+          targetGroup = targetLayerId,
+          toolbarOptions = processOpts(leafpm::pmToolbarOptions,
+                                       editorArgs[["toolbarOptions"]]),
+          drawOptions = processOpts(leafpm::pmDrawOptions,
+                                    editorArgs[["drawOptions"]]),
+          editOptions = processOpts(leafpm::pmEditOptions,
+                                    editorArgs[["editOptions"]]),
+          cutOptions = processOpts(leafpm::pmCutOptions,
+                                   editorArgs[["cutOptions"]])
+          )
+    }
+}
+

R/draw.R

@@ -16,6 +16,9 @@
 #'          behaviour in Firefox.
 #' @param title \code{string} to customize the title of the UI window.
 #' @param editor \code{character} either "leaflet.extras" or "leafpm"
+#' @param editorOptions \code{list} of options suitable for passing to
+#'     either \code{leaflet.extras::addDrawToolbar} or
+#'     \code{leafpm::addPmToolbar}.
 #' @param ... additional arguments passed on to \code{\link{editMap}}.
 #'
 #' @details
@@ -35,13 +38,15 @@ drawFeatures = function(map = NULL,
                         viewer = shiny::paneViewer(),
                         title = "Draw Features",
                         editor = c("leaflet.extras", "leafpm"),
+                        editorOptions = list(),
                         ...) {
   res = editMap(x = map,
                 sf = sf,
                 record = record,
                 viewer = viewer,
                 title = title,
                 editor = editor,
+                editorOptions = editorOptions,
                 ...)
   if (!inherits(res, "sf") && is.list(res)) res = res$finished
   return(res)

R/edit.R

@@ -35,6 +35,9 @@ editMap <- function(x, ...) {
 #' @param title \code{string} to customize the title of the UI window.  The default
 #'          is "Edit Map".
 #' @param editor \code{character} either "leaflet.extras" or "leafpm"
+#' @param editorOptions \code{list} of options suitable for passing to
+#'     either \code{leaflet.extras::addDrawToolbar} or
+#'     \code{leafpm::addPmToolbar}.
 #'
 #' @details
 #'   When setting \code{viewer = browserViewer(browser = getOption("browser"))} and
@@ -53,6 +56,7 @@ editMap.leaflet <- function(
   crs = 4326,
   title = "Edit Map",
   editor = c("leaflet.extras", "leafpm"),
+  editorOptions = list(),
   ...
 ) {
   stopifnot(!is.null(x), inherits(x, "leaflet"))
@@ -99,7 +103,8 @@ $(document).on('shiny:disconnected', function() {
       sf = sf,
       record = record,
       crs = crs,
-      editor = editor
+      editor = editor,
+      editorOptions = editorOptions
     )
 
     observe({crud()})
@@ -140,6 +145,7 @@ editMap.mapview <- function(
   crs = 4326,
   title = "Edit Map",
   editor = c("leaflet.extras", "leafpm"),
+  editorOptions = list(),
   ...
 ) {
   stopifnot(!is.null(x), inherits(x, "mapview"), inherits(x@map, "leaflet"))
@@ -148,13 +154,15 @@ editMap.mapview <- function(
     x@map, targetLayerId = targetLayerId, sf = sf,
     ns = ns, viewer = viewer, record = TRUE, crs = crs,
     title = title,
-    editor = editor
+    editor = editor,
+    editorOptions = editorOptions
   )
 }
 
 #' @name editMap
 #' @export
-editMap.NULL = function(x, editor = c("leaflet.extras", "leafpm"), ...) {
+editMap.NULL = function(x, editor = c("leaflet.extras", "leafpm"),
+                        editorOptions = list(), ...) {
   m = mapview::mapview()@map
   m = leaflet::fitBounds(
     m,
@@ -163,7 +171,8 @@ editMap.NULL = function(x, editor = c("leaflet.extras", "leafpm"), ...) {
     lng2 = 180, #as.numeric(sf::st_bbox(x)[3]),
     lat2 = 90 #as.numeric(sf::st_bbox(x)[4])
   )
-  ed = editMap(m, record = TRUE, editor = editor)
+  ed = editMap(m, record = TRUE, editor = editor,
+               editorOptions = editorOptions)
   ed_record <- ed$finished
   attr(ed_record, "recorder") <- attr(ed, "recorder", exact = TRUE)
   ed_record
@@ -202,6 +211,9 @@ editFeatures = function(x, ...) {
 #' @param title \code{string} to customize the title of the UI window.  The default
 #'          is "Edit Map".
 #' @param editor \code{character} either "leaflet.extras" or "leafpm"
+#' @param editorOptions \code{list} of options suitable for passing to
+#'     either \code{leaflet.extras::addDrawToolbar} or
+#'     \code{leafpm::addPmToolbar}.
 #'
 #' @details
 #'   When setting \code{viewer = browserViewer(browser = getOption("browser"))} and
@@ -224,6 +236,7 @@ editFeatures.sf = function(
   label = NULL,
   title = "Edit Map",
   editor = c("leaflet.extras", "leafpm"),
+  editorOptions = list(),
   ...
 ) {
 
@@ -268,27 +281,13 @@ editFeatures.sf = function(
     )
   }
 
-  # currently we don't have a way to set custom options for leaflet.pm
-  # and we will want to customize allowSelfIntersection depending on feature types
   if(inherits(map, "mapview")) map = map@map
-  if(editor[1] == "leafpm") {
-    # now let's see if any of the features are polygons
-    if(any(sf::st_dimension(x) == 2)) {
-      map = leafpm::addPmToolbar(
-        map,
-        targetGroup = "toedit",
-        toolbarOptions = leafpm::pmToolbarOptions(drawCircle = FALSE),
-        drawOptions = leafpm::pmDrawOptions(allowSelfIntersection = FALSE),
-        editOptions = leafpm::pmEditOptions(allowSelfIntersection = FALSE),
-        cutOptions = leafpm::pmCutOptions(allowSelfIntersection = FALSE)
-      )
-    }
-  }
 
   crud = editMap(
     map, targetLayerId = "toedit",
     viewer = viewer, record = record,
-    crs = crs, title = title, editor = editor, ...
+    crs = crs, title = title,
+    editor = editor, editorOptions = editorOptions, ...
   )
 
   merged <- Reduce(

R/modules.R

@@ -1,3 +1,4 @@
+
 #' Shiny Module UI for Geo Selection
 #'
 #' @param id \code{character} id for the the Shiny namespace
@@ -99,6 +100,9 @@ editModUI <- function(id, ...) {
 #' @param record \code{logical} to record all edits for future playback.
 #' @param crs see \code{\link[sf]{st_crs}}.
 #' @param editor \code{character} either "leaflet.extras" or "leafpm"
+#' @param editorOptions \code{list} of options suitable for passing to
+#'     either \code{leaflet.extras::addDrawToolbar} or
+#'     \code{leafpm::addPmToolbar}.
 #'
 #' @return server function for Shiny module
 #' @import shiny
@@ -110,39 +114,14 @@ editMod <- function(
   sf = TRUE,
   record = FALSE,
   crs = 4326,
-  editor = c("leaflet.extras", "leafpm")
+  editor = c("leaflet.extras", "leafpm"),
+  editorOptions = list()
 ) {
+  editor <- match.arg(editor)
   # check to see if addDrawToolbar has been already added to the map
-  if(is.null(
-    Find(
-      function(cl) {
-        cl$method == "addDrawToolbar" || cl$method == "addPmToolbar"
-      },
-      leafmap$x$calls
-    )
-  )) {
-    if(editor[1] == "leaflet.extras") {
-      # add draw toolbar if not found
-      leafmap <- leaflet.extras::addDrawToolbar(
-        leafmap,
-        targetGroup = targetLayerId,
-        polylineOptions = leaflet.extras::drawPolylineOptions(repeatMode = TRUE),
-        polygonOptions = leaflet.extras::drawPolygonOptions(repeatMode = TRUE),
-        circleOptions = FALSE,
-        rectangleOptions = leaflet.extras::drawRectangleOptions(repeatMode = TRUE),
-        markerOptions = leaflet.extras::drawMarkerOptions(repeatMode = TRUE),
-        circleMarkerOptions = leaflet.extras::drawCircleMarkerOptions(repeatMode = TRUE),
-        editOptions = leaflet.extras::editToolbarOptions()
-      )
-    }
-
-    if(editor[1] == "leafpm") {
-      leafmap <- leafpm::addPmToolbar(
-        leafmap,
-        targetGroup = targetLayerId,
-        toolbarOptions = leafpm::pmToolbarOptions(drawCircle = FALSE)
-      )
-    }
+  if(!any(sapply(leafmap$x$calls, "[[", "method") %in%
+          c("addDrawToolbar", "addPmToolbar"))) {
+      leafmap <- addToolbar(leafmap, editorOptions, editor, targetLayerId)
   }
 
   output$map <- leaflet::renderLeaflet({leafmap})
@@ -151,14 +130,16 @@ editMod <- function(
     drawn = list(),
     edited_all = list(),
     deleted_all = list(),
-    finished = list()
+    finished = list(),
+    all = list()
   )
 
   recorder <- list()
 
   EVT_DRAW <- "map_draw_new_feature"
   EVT_EDIT <- "map_draw_edited_features"
   EVT_DELETE <- "map_draw_deleted_features"
+  EVT_ALL <- "map_draw_all_features"
 
   shiny::observeEvent(input[[EVT_DRAW]], {
     featurelist$drawn <- c(featurelist$drawn, list(input[[EVT_DRAW]]))
@@ -211,10 +192,17 @@ editMod <- function(
     featurelist$deleted_all <- c(featurelist$deleted_all, list(deleted))
   })
 
+  shiny::observeEvent(input[[EVT_ALL]], {
+    featurelist$all <- list(input[[EVT_ALL]])
+    if (any(unlist(input[[EVT_ALL]]$geometry$coordinates) < -180) ||
+        any(unlist(input[[EVT_ALL]]$geometry$coordinates) > 180))
+      insane_longitude_warning()
+  })
+
   # record events if record = TRUE
   if(record == TRUE) {
     lapply(
-      c(EVT_DRAW, EVT_EDIT, EVT_DELETE),
+      c(EVT_DRAW, EVT_EDIT, EVT_DELETE, EVT_ALL),
       function(evt) {
         observeEvent(input[[evt]], {
           recorder <<- c(
@@ -240,7 +228,8 @@ editMod <- function(
       drawn = featurelist$drawn,
       edited = featurelist$edited_all,
       deleted = featurelist$deleted_all,
-      finished = featurelist$finished
+      finished = featurelist$finished,
+      all = featurelist$all
     )
     # if sf argument is TRUE then convert to simple features
     if(sf) {