resink branch

DESCRIPTION

@@ -1,8 +1,8 @@
 Package: pointR
 Type: Package
-Date: 2019-12-30
+Date: 2021-08-20
 Title: pointR
-Version: 0.4.1.11
+Version: 0.5.3
 Author: M.S.Legrand
 Maintainer: M.S.Legrand <slegrand3.14@gmail.com>
 Description: pointR is a shiny-based IDE for svgR
@@ -20,6 +20,7 @@ Imports:
     shinyDMDMenu,
     shinyFiles,
     shinythemes,
+    shinyalert,
     colourpicker,
     shinyWidgets,
     bsplus,
@@ -29,7 +30,7 @@ Imports:
     shinyjqui
 Suggests:
     testthat
-RoxygenNote: 6.1.1
+RoxygenNote: 7.1.1
 Remotes: 
   mslegrand/shinyDMDMenu,
   mslegrand/svgR,

LICENSE.txt

@@ -1,6 +1,6 @@
 			NOTICE
 
-Copyright (c) 2020 M. S. Legrand. All rights reserved
+Copyright (c) 2021 M. S. Legrand. All rights reserved
 
 The pointR package as a whole is distributed under the GPL-3 License,
 GNU GENERAL PUBLIC LICENSE version 3, see below.

README.md

@@ -1,43 +1,61 @@
-# pointR
 
-**pointR** is an R package providing a *shiny-based* minimalist ide for R scripting using svgR
-- ***Videos on pointR*** can be found at http://mslegrand.github.io/pointRmedia/.
+## Installation 
+
+For a full featured install go to http://mslegrand.github.io/pointR/. There you will find package installers for linux, mac and windows. 
+
+## pointR and ptR
+
+- **pointR** is an R package providing a *shiny-based* minimalist IDE for R scripting using svgR. **pointR** is primarly written in R, with a little bit of javascript for seasoning.
+- **ptR** is an **Electron** wrapper around **pointR**. 
+- Using **Electron** 
+	- Removes potential hiccups by removing and dependency on the local browser 
+	- Provides independent windows for help
+	- Provides an integrated approach for building **shiny custom inputs**
+
 - ***Related information*** can be found at http://mslegrand.github.io/svgR/.
 - ***Rambling thoughts*** can be found on the wiki at https://github.com/mslegrand/pointR/wiki
 
-## Some Points on PointR
+## Some Points on pointR
 -  pointR is a shiny server application
 -  pointR uses the ACE editor for coding
 -  pointR is intended to ease the writing of R scripts using svgR.
 -  pointR is an attempt to bridge the gap between coding and point&click.
 -  svgR bridges the gap between R and SVG
 
-## Try Out
-- runGitHub("pointR", "mslegrand")
-
-# Installation
-- install.packages("devtools")
-- library(devtools)
-- install_github("shiny", "rstudio")
-- install_github("shinyAce", "trestletech")
-- install_github("shinyjs", "daattali")
-- install_github("svgR", "mslegrand")
-
-# Reporting issues
+## Some Points on ptR
+- ptR is an Electron wrapper around pointR
+- ptR is javascript (since Electron is)
+- Electron is required for full functionality (such as building shiny input controls)
+
+
+
+## Building from Source
+
+0. Warning, you might find this painful.
+1. [Download pointR](https://github.com/mslegrand/pointR) and build the **pointR** library
+2. [Download ptR](https://github.com/mslegrand/ptR) and place in a folder (like pointR-electron/ptRMigrate)
+3. cd to ptRMigrate and edit script ./build/mklib.sh to copy the ptR lib to 2 locations (for testing & production)
+4. Install node.js, npm, electon
+5. from terminal run **npm start**
+
+**NOTE** I've built both on linux and mac machines, but not windows.
+
+
+## Reporting issues
 Please report any bugs/issue in the 
 [Github Issue tracker](https://github.com/mslegrand/pointR)
 
 #Contributing
 If you wish to contribute to the pointR project, now is the time. Thanks.
 
-# Caution
+## Caution
 To quote from TrestleTech: *As with any online application, it is a genuinely bad idea to allow arbitrary users to execute code on your server.* **BE CAREFUL!!**
 
-# Licensing
+## Licensing
 
 			NOTICE
 
-Copyright (c) 2018 M. S. Legrand. All rights reserved
+Copyright (c) 2020 M. S. Legrand. All rights reserved
 
 The pointR package as a whole is distributed under the GPL-3 License,
 GNU GENERAL PUBLIC LICENSE version 3, see below.

inst/App/fileIO/dndSnippetLoader.R

@@ -21,9 +21,11 @@ dripplets2Rmd<-function( drps ){
   unlist(str_split(drps, '\n'))->drps
   indx<-m[2,]
   drps[indx]<-paste(
-    "temp$root$setAttr('width',480)",
-    "temp$root$setAttr('height',320)",
-    "temp$root$setAttr('viewBox','0 0  48 32')",
+     "temp$root$setAttr('width',48)",
+     "temp$root$setAttr('height',32)",
+    # "temp$root$setAttr('viewBox','0 0  48 32')",
+    "temp$root$setAttr('stroke','#00FFFF')",
+    "temp$root$setAttr('fill','#00FFFF')",
     "temp$root$prependChildren(
       svgR:::use(filter=svgR:::filter( filterUnits='userSpaceOnUse', svgR:::feFlood(flood.color='black') ) )
     )",
@@ -35,7 +37,7 @@ dripplets2Rmd<-function( drps ){
   drps<-str_replace(drps, "\noutput: dnd_snippet", "\noutput: html_document")
   drps<-str_replace_all(drps, "POPUP\\s*\n```\n(.+)\n```", "### \\1")
   drps<-str_replace_all(drps, "\nSNIPPET\\s*","\n")
-  drps<-str_replace_all(drps, "\nSVGR\\s*\n```\n", '\n\n```\\{r, echo=FALSE, results=\'asis\'\\}\n')
+  drps<-str_replace_all(drps, "\nSVGR\\s*\n```\n", '\n\n```\\{r, echo=FALSE, results=\'asis\'\\}\nWH=c(48,32)\n')
   drps
 }
 
@@ -95,7 +97,15 @@ extractDripplet<-function(dr ){
   if(all(m>0)){
     rtv<-tt
     rtv<-tryCatch({
-       svg<-as.character(eval(parse(text=tt['SVGR']), new.env()))
+       # svg<-as.character(eval(parse(text=tt['SVGR']), new.env()))
+       # svg<-eval(parse(text=tt['SVGR']), new.env())
+       svg<-eval(parse(text=tt['SVGR']), list(WH=c(48,32)))
+       svg$root$setAttr('stroke','#00FFFF')
+       svg$root$setAttr('fill','#00FFFF')
+       svg$root$setAttr('width',48)
+       svg$root$setAttr('height',32)
+       #set width, height???
+       svg<-as.character(svg)
        rtv["SVGR"]<-svg
        names(rtv)<-c('hint','snip','logo')[m]
        rtv
@@ -119,10 +129,20 @@ dripplets2List2<-function(drps){
     rtv<-extractDripplet(dr)
     rtv
   })
-
+  s.upper<-function(s){
+    paste(toupper(substring(s, 1, 1)), substring(s, 2),
+          sep = "", collapse = " ")
+  }
+  drps<-lapply(drps, function(dr){
+    dr['snip']<-gsub("\\```","```" , dr['snip'])
+    dr
+  })
   if(!is.null(editOption$currentProjectName)){
+    cname<-sub('\\.pprj$','', editOption$currentProjectName)
+    Cname<-s.upper(cname)
     drps<-lapply(drps, function(dr){
-      dr['snip']<-gsub('@projectName@', editOption$currentProjectName, dr['snip'])
+      dr['snip']<-gsub('@projectName@', cname , dr['snip'])
+      dr['snip']<-gsub('@ProjectName@', Cname , dr['snip'])
       dr
     })
   }

inst/App/fileIO/genShinyFilesOpenButtons.R

@@ -9,6 +9,7 @@ UIGenShinyOpenFilesButtons<-function(){
     shinyFilesButton("buttonFileOpen",        label="", title="Open File",                        multiple=FALSE,  class='hiddenButton'),
     shinyFilesButton("buttonFileOpenProject", label="", title="Select Project to Open",           multiple=FALSE,  class='hiddenButton'),
 
+    shinyFilesButton("buttonChoiceSetImport", label="", title="Import Choice Set",                       multiple=FALSE,  class='hiddenButton'),
     shinyFilesButton("buttonSnippetImport",   label="", title="Import Snippets",                         multiple=FALSE,  class='hiddenButton'),
     shinyFilesButton("buttonDnippetImport",   label="", title="Import Dnippets",                           multiple=FALSE,  class='hiddenButton'),
     shinyFilesButton("buttonPreProcPtImport", label="", title="Import PreProcessors for points",                  multiple=FALSE,   class='hiddenButton'),

inst/App/fileIO/genShinyFilesSaveButtons.R

@@ -4,7 +4,7 @@ saveButtonFileNames<-setNames(paste0('buttonFileSave', extMode.TB$ext), extMode.
 UIGenShinySaveFilesButtons<-function(){
   tt<-setNames(as.list(extMode.TB$ext),extMode.TB$mode)
   fileTypes<-lapply(tt, function(x){
-    xx<-c(x,tt[tt!=x])
+    xx<-c(x,tt[tt!=x]) #move the prefered mode to the top
     setNames(as.list(xx),xx)
   }) 
   tmp<-lapply(extMode.TB$mode, function(mode){

inst/App/fileIO/observeRequestStartUp.R

@@ -11,11 +11,21 @@ observeEvent(trigger$startup, {
     } else {
 
     }
-    disableDMDM(
-      session, 
-      menuBarId="editNavBar", 
-      entry="customControl"
-    )
 
+    updateNewProjectMenu(session)
+    updateRemoveTemplateMenu(session)
+    resetWatcher()
+    readAuxChoices()
     log.fout(startup)
 }, priority=100)
+
+
+resetWatcher<-reactive({
+  if(usingElectron){
+    allFilePaths<-getAllNamedFiles()$filePath
+    allFilePaths<-normalizePath(allFilePaths)
+    # cat('pointR::resetWatcher: allFilePaths')
+    # print(allFilePaths)
+    sendPtRManagerMessage(sender="cmd.electron", resetWatcher=allFilePaths)
+  }
+})

inst/App/fileIO/serverFileDescriptor.R

@@ -1,12 +1,6 @@
 
 fileDescDB<-reactiveVal(
-  tibble(
-    tabId='bogus',
-    isSaved=FALSE,
-    filePath="?",
-    anonNo =1,
-    mode='ptr'
-  )[0,]
+  initialFileDescDB()
 )
 
 getNextAnonymousFileName<-reactive({
@@ -20,22 +14,24 @@ getNextAnonFileNum<-reactive({
 })
 
 # to be called from serverFileTab.R::addFileTab
-addFileDesc<-function( pageId, docFilePath, fileSaveStatus, fileMode){
+addFileDesc<-function( pageId, docFilePath, fileSaveStatus, fileMode, parId=NA, parMode=NA){
   if(identical(docFilePath,"?")){
     anonNo<-getNextAnonFileNum()
   } else {
     anonNo<-0
   }
+  if(is.null(parId)){
+    parId=NA
+  }
   tb<-tibble(tabId=pageId, isSaved=fileSaveStatus,  
-             filePath=docFilePath, anonNo, mode=fileMode)
+             filePath=docFilePath, anonNo, mode=fileMode, parId=parId, parMode=parMode)
   fd<- fileDescDB()
   fd<-bind_rows(fd,tb)
   fileDescDB(fd)
 }
 
 
 getMode<-reactive({
-  # cat('>---> getMode\n')
   tabId<-input$pages # getTibTabId()
   if(is.null(tabId) || identical(tabId, 'bogus')){
     mode<-NULL
@@ -48,6 +44,22 @@ getMode<-reactive({
   mode
 })
 
+getParMode<-reactive({
+  # cat('>---> getParMode\n')
+  tabId<-input$pages # getTibTabId()
+  # cat(paste('tabId=',format(tabId)))
+  if(is.null(tabId) || identical(tabId, 'bogus')){
+    parMode<-NULL
+  } else {
+    fd<-fileDescDB()
+    parMode<-fd[fd$tabId==input$pages,]$parMode
+    if(length(parMode)>0 && is.na(parMode)){
+      parMode<-NULL
+    }
+  }
+  parMode
+})
+
 # in getModeX we need to insert flag to enable/disable appmode
 # we could use shinyjs to query a property of a (hidden) node?
 # or use ptR.js to do an on.change ?
@@ -121,7 +133,7 @@ setFileDescSaved<-function(pageId, fileSaveStatus){
         fd[fd$tabId==pageId,"isSaved"]<-fileSaveStatus 
         fileDescDB(fd) 
       }
-      cat('setFileDescSaved: pageId=',pageId,',  savedStatus=',fileSaveStatus,"\n")
+      # cat('setFileDescSaved: pageId=',pageId,',  savedStatus=',fileSaveStatus,"\n")
 
       sendFileTabsMessage(tabId=pageId, sender='savedStatus', saveStatus=fileSaveStatus)
       log.fout(setFileDescSaved)
@@ -137,6 +149,15 @@ getAllNamedUnsavedFiles<-reactive({
   fd
 })
 
+getAllNamedFiles <- function(){
+  fd<-fileDescDB()
+  fd<-filter(fd, filePath!="?")
+  fd
+}
+
+
+
+
 # get the saved status for the current page
 getFileSavedStatus<-reactive({
   pageId<-input$pages
@@ -177,3 +198,6 @@ removeFileDesc<-function(pageId, path=getWorkSpaceDir() ){
   # cat('<---< removeFileDesc\n')
 }
 
+
+
+

inst/App/fileIO/serverGenShinyFilesSaveObservers.R

@@ -14,12 +14,13 @@ genShinySaveFilesObservers<-function(input, session){
       if('cancel' %in% names(rtList)){
         if(rtList$cancel=='close'){ 
           tabId=popTabRequest()
-          if(mssg$docFilePath!="?"){
-            addToRecentFiles(mssg$docFilePath)
+          docFilePath=getFileDescriptor(tabId)$filePath
+          if(!is.null(docFilePath) && docFilePath!="?"){ 
+            addToRecentFiles(docFilePath)
           }
           closeTabNow(tabId)
         } else {
-          setTabRequest(sender=NULL, tabs=NULL)
+          setTabRequest(cmd=NULL, tabs=NULL)
         }
       } else { 
         fp.dt<-parseSavePath(c(home='~'), rtList)

inst/App/fileIO/serverLoadWorkSpace.R

@@ -27,20 +27,23 @@ restoreWorkSpace<-reactive({
   }
   wsPages<-list()
 
-
   ptRproj<-pprj()
 
   selectedTab<-readCurrentTab()
   tabs=c()
 
   # 1. load all pages into a list.
   for(filePath in fileWSPaths){
+
     page<-readRDS(filePath)
     # A. assign tabIds to each page
     id=basename(filePath)
     if(!is.null(ptRproj$pathToProj)){
       docFilePath=page$fileDescriptor.filePath
       page$fileDescriptor.filePath<-sub( ptRproj$pathToProj, editOption$currentProjectDirectory, docFilePath)
+      if(!file.exists(page$fileDescriptor.filePath)){
+        next # omit this, else saving will cause an error
+      }
       saveRDS(page,filePath)
     }
     wsPages[[id]]<-page
@@ -53,10 +56,14 @@ restoreWorkSpace<-reactive({
       if(length(tibAs)>0){
         names(tibAs)<-gsub(pattern, '', names(tibAs))
         tibAs[sapply(tibAs,is.null)]<-NA
+        setdiff(names(initTib),names(tibAs))->tmp
+        if(length(tmp)>0){
+          tmp<-sapply(tmp, function(x){NA}, USE.NAMES = T)
+          tibAs<-c(tibAs,tmp)
+        }
       }
       tibAs
     })
-
     rtv<-bind_rows( rtv)
     if(ncol(rtv)==0){
       rtv<-initTib
@@ -88,10 +95,12 @@ restoreWorkSpace<-reactive({
     fileSaveStatus=page$fileDescriptor.isSaved
 
     txt=page$code
-    if(fileSaveStatus==TRUE && file.exists(docFilePath)){ 
+
+    if(identical(fileSaveStatus,TRUE) && file.exists(docFilePath)){ 
       tryCatch(
         {txt<-paste(readLines(docFilePath), collapse="\n")},
         error=function(e){
+          e<-e$message
           cat("Unable to read file:", paste(e, collapse="\n"))
           return(NULL) #bail
         }