Merge pull request #5 from jfisher-usgs/master

Merge with upstream

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: RSurvey
 Title: Geographic Information System Application
-Version: 0.9.0.9000
+Version: 0.9.1
 Authors@R: person(given=c("Jason", "C."), family="Fisher", role=c("aut", "cre"), email="[email protected]")
 Description: A geographic information system (GIS) graphical user interface (GUI) that
   provides data viewing, management, and analysis tools.
@@ -28,9 +28,10 @@ Suggests:
 SystemRequirements: Tcl/Tk (>= 8.5), Tktable (>= 2.9, optional)
 License: CC0
 Copyright: This software is in the public domain because it contains materials
-    that originally came from the USGS, an agency of the United States
-    Department of Interior. For more information, see the official USGS
-    copyright policy at https://www2.usgs.gov/visual-id/credit_usgs.html
+    that originally came from the United States Geological Survey (USGS),
+    an agency of the United States Department of Interior. For more information,
+    see the official USGS copyright policy at
+    https://www2.usgs.gov/visual-id/credit_usgs.html
 URL: https://github.com/USGS-R/RSurvey
 BugReports: https://github.com/USGS-R/RSurvey/issues
 Encoding: UTF-8

NEWS.md

@@ -1,8 +1,12 @@
-# RSurvey 0.9.0.9000
+# RSurvey 0.9.1
 
-- Account for coordinate reference system not being applicable for coordinate data.
+- Replace R copy/paste commands with those in Tcl/Tk.
 
-- Use valid Tk key binding names, prevents errors on Linux OS.
+- Move package repository to [USGS-R/RSurvey](https://github.com/USGS-R/RSurvey) on GitHub.
+
+- Account for coordinate reference system not being applicable for spatial data.
+
+- Use valid Tk-key-binding names, prevents errors on Linux OS.
 
 # RSurvey 0.9.0
 

R/EditData.R

@@ -333,8 +333,11 @@ EditData <- function(d, col.names=names(d), row.names=NULL, col.formats=NULL,
       return()
     }
     vals <- FormatValues(ij[, 1], ij[, 2])
-    utils::write.table(matrix(vals, nrow=ni, ncol=nj, byrow=TRUE), file="clipboard",
-                       sep="\t", eol="\n", row.names=FALSE, col.names=FALSE)
+    txt <- matrix(vals, nrow=ni, ncol=nj, byrow=TRUE)
+    txt <- utils::capture.output(utils::write.table(txt, sep="\t", row.names=FALSE, col.names=FALSE))
+    txt <- paste(txt, collapse="\n")
+    tkclipboard.clear()
+    tkclipboard.append(txt)
     return()
   }
 
@@ -367,22 +370,24 @@ EditData <- function(d, col.names=names(d), row.names=NULL, col.formats=NULL,
     tclServiceMode(FALSE)
     on.exit(tclServiceMode(TRUE))
     active.cell <- as.character(tkindex(f3.tbl, "active"))
-    args <- list(file="clipboard", colClasses="character", sep="\t",
-                 flush=TRUE, fill=TRUE, na.strings=NULL)
-    new.vals <- suppressWarnings(try(do.call(utils::read.table, args), silent=TRUE))
-    if (inherits(new.vals, "try-error")) return()
-    match.length <- attr(regexpr("\t", new.vals, fixed=TRUE), "match.length")
+    txt <- as.character(tclvalue(.Tcl("selection get -selection CLIPBOARD")))
+    if (length(txt) == 0) return()
+    args <- list(text=txt, colClasses="character", sep="\t", flush=TRUE,
+                 fill=TRUE, na.strings=NULL)
+    cb <- try(do.call(utils::read.table, args), silent=TRUE)
+    if (inherits(cb, "try-error")) return()
+    match.length <- attr(regexpr("\t", cb, fixed=TRUE), "match.length")
     if (!all(match.length == match.length[1])) {
-      msg <- paste("Clipboard contains text string copied from multiple",
+      msg <- paste("Clipboard contains data copied from multiple",
                    "selections and is unsuitable for pasting.")
       tkmessageBox(icon="info", message=msg, title="Paste", type="ok", parent=tt)
       return()
     }
     active.ij <- as.integer(strsplit(active.cell, ",")[[1]])
-    m <- nrow(new.vals)
-    n <- ncol(new.vals)
+    m <- nrow(cb)
+    n <- ncol(cb)
     ij <- cbind(rep(seq_len(m), n), rep(seq_len(n), each=m))
-    new.vals <- new.vals[ij]
+    new.vals <- cb[ij]
     ij[, 1] <- ij[, 1] + active.ij[1] - 1L
     ij[, 2] <- ij[, 2] + active.ij[2] - 1L
     i <- ij[, 1]

R/Format.R

@@ -237,15 +237,19 @@ Format <- function(sample=pi, fmt="", parent=NULL) {
   # copy format to clipboard
   CopyFormat <- function() {
     txt <- as.character(tclvalue(fmt.var))
-    cat(txt, file="clipboard")
+    tkclipboard.clear()
+    tkclipboard.append(txt)
   }
 
 
   # paste format from clipboard
   PasteFormat <- function() {
     opt <- as.integer(tclvalue(opt.var))
     if (opt != 3L) return()
-    cb <- try(scan(file="clipboard", what="character", sep="\n", quiet=TRUE), silent=TRUE)
+    txt <- as.character(tclvalue(.Tcl("selection get -selection CLIPBOARD")))
+    if (length(txt) == 0) return()
+    args <- list(text=txt, what="character", sep="\n", quiet=TRUE)
+    cb <- try(do.call(scan, args), silent=TRUE)
     if (inherits(cb, "try-error")) return()
     tclvalue(fmt.var) <- cb
     UpdateSample()

R/FormatDateTime.R

@@ -96,13 +96,17 @@ FormatDateTime <- function(sample=as.POSIXct("1991-08-25 20:57:08"), fmt="", par
   # copy format to clipboard
   CopyFormat <- function() {
     txt <- as.character(tclvalue(fmt.var))
-    cat(txt, file="clipboard")
+    tkclipboard.clear()
+    tkclipboard.append(txt)
   }
 
 
   # paste format from clipboard
   PasteFormat <- function() {
-    cb <- try(scan(file="clipboard", what="character", sep="\n", quiet=TRUE), silent=TRUE)
+    txt <- as.character(tclvalue(.Tcl("selection get -selection CLIPBOARD")))
+    if (length(txt) == 0) return()
+    args <- list(text=txt, what="character", sep="\n", quiet=TRUE)
+    cb <- try(do.call(scan, args), silent=TRUE)
     if (inherits(cb, "try-error")) return()
     tclvalue(fmt.var) <- cb
     UpdateSample()

R/ImportText.R

@@ -453,7 +453,10 @@ ImportText <- function(parent=NULL) {
   # paste clipboard
   PasteData <- function() {
     tkselection.set(f4.tbl, "origin")
-    cb <- try(scan(file="clipboard", what="character", sep="\n", quiet=TRUE), silent=TRUE)
+    txt <- as.character(tclvalue(.Tcl("selection get -selection CLIPBOARD")))
+    if (length(txt) == 0) return()
+    args <- list(text=txt, what="character", sep="\n", quiet=TRUE)
+    cb <- try(do.call(scan, args), silent=TRUE)
     cb <<- if (inherits(cb, "try-error")) NULL else cb
     if (is.null(cb)) return()
     tclvalue(source.var) <- ""

R/zzz.R

@@ -15,6 +15,8 @@
       packageStartupMessage(paste(strwrap(s, indent=1), collapse="\n "))
     }
     LaunchGui()
+  } else {
+    packageStartupMessage("The RSurvey GUI is launched only in interactive sessions.")
   }
   invisible()
 }

README.md

@@ -1,8 +1,8 @@
 # RSurvey
 
-[![Travis-CI Build Status](https://travis-ci.org/USGS-R/RSurvey.svg?branch=master)](https://travis-ci.org/USGS-R/RSurvey)
-[![AppVeyor Build Status](https://ci.appveyor.com/api/projects/status/github/USGS-R/RSurvey?branch=master&svg=true)](https://ci.appveyor.com/project/jfisher-usgs/RSurvey)
-[![CRAN_Status_Badge](https://www.r-pkg.org/badges/version/RSurvey)](https://CRAN.R-project.org/package=RSurvey)
+[![Travis Build Status](https://travis-ci.org/USGS-R/RSurvey.svg?branch=master)](https://travis-ci.org/USGS-R/RSurvey)
+[![AppVeyor Build Status](https://ci.appveyor.com/api/projects/status/2iqeunfhx593megv?svg=true)](https://ci.appveyor.com/project/jfisher-usgs/rsurvey)
+[![CRAN Version](https://www.r-pkg.org/badges/version/RSurvey)](https://CRAN.R-project.org/package=RSurvey)
 
 ## Overview