New editOptions= argument for lower-level toolbar customization

The new `editOptions=` argument takes a user-supplied list of named
options that are ultimately passed on to either
`leafpm::addPmToolbar()` or `leaflet.extras::addDrawToolbar()`,
depending on the value of the `editor=` argument.

When `editor = "leafpm"`, the list can consist of one or more elements
with names `"toolbarOptions"`, `"drawOptions"`, `"editOptions"`, and
`"cutOptions"`. For details, see `?leafpm::addPmToolbar`.

When `editor = "leaflet.extras"`, allowable names for list elements are
`"polylineOptions`, `"polygonOptions"`, `"circleOptions"`,
`"rectangleOptions"`, `"makerOptions"`, `"circleMarkerOptions"`, and
`"editOptions"`. For details, see `?leaflet.extras::addDrawToolbar`.

Currently, there is no checking or validation of the list passed in to
`editorOptions=`, so users will need to take particular care that the
list's structure (including the names of all of its elements) match
with what is expected by the `leafpm::addPmToolbar()` or
`leaflet.extras::addDrawToolbar()` functions.

Here are few simple examples demonstrating the new argument's usage:

```r

library(sf)
library(mapedit)

x <- list(matrix(c(11,0,11,1,12,1,12,0,11,0), ncol = 2, byrow = TRUE))
pp <- st_sf(geom = st_sfc(st_polygon(x)), crs = 4326)

optsA <- list(drawOptions = list(snappable = FALSE,
                                 hintlineStyle = list(color = "red",
                                                      opacity = 0.5),
                                 templineStyle = list(color = "red")),
              editOptions = list(snappable = FALSE))
x <- editFeatures(pp, editor = "leafpm", editorOptions = optsA)

optsB <- list(editOptions = list(remove = FALSE),
              circleOptions = FALSE,
              markerOptions = FALSE,
              circleMarkerOptions = FALSE,
              rectangleOptions = FALSE)
x <- editFeatures(pp, editor = "leaflet.extras", editorOptions = optsB)
```

R/addToolbar.R

@@ -0,0 +1,111 @@
+
+
+##' @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 one of the formals of either for passage 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(isFALSE(args)) {
+        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 <- 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/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(),
   ...
 ) {
 
@@ -273,7 +286,8 @@ editFeatures.sf = function(
   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
@@ -110,54 +111,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 == "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 == "leafpm") {
-        # Need for `allowSelfIntersection` arguments depends on whether
-        # features are 2-d (polygons and lines) or 1-d (points)
-        if(any(sapply(leafmap$x$calls, "[[", "method") %in%
-               c("addPolylines", "addPolygons"))) {
-          leafmap <- leafpm::addPmToolbar(
-          leafmap,
-          targetGroup = targetLayerId,
-          toolbarOptions = leafpm::pmToolbarOptions(drawCircle = FALSE),
-          drawOptions = leafpm::pmDrawOptions(allowSelfIntersection = FALSE),
-          editOptions = leafpm::pmEditOptions(allowSelfIntersection = FALSE),
-          cutOptions = leafpm::pmCutOptions(allowSelfIntersection = FALSE)
-          )
-      } else {
-        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})