add global env flag to tools (#1134)

Follow up to #1132; adds a flag to disable the new default behavior.

Note: this also makes gxpkg default behavior consistent with everything
else; it drops the `-l` flag which is now default and uses the `-g` flag
instead.

6 files changed, 110 insertions, 111 deletions

diff --git a/src/tools/env.ss b/src/tools/env.ss
index 684640fe..16917454 100644
--- a/src/tools/env.ss
+++ b/src/tools/env.ss
@@ -1,14 +1,25 @@
 ;;; -*- Gerbil -*-
 ;;; © vyzo
 ;;; common environment context for tools
-(import (only-in :gerbil/runtime/init cons-load-path))
+(import (only-in :std/cli/getopt flag)
+        (only-in :gerbil/runtime/init cons-load-path))
 (export #t)
 
-(def (setup-local-env!)
+(def global-env-flag
+  (flag 'global-env "-g" "--global-env"
+        help: "use the user global env even in local package context"))
+
+(def (setup-local-env! opt)
+  (unless (hash-get opt 'global-env)
+    (setup-local-pkg-env! #f)))
+
+(def (setup-local-pkg-env! create?)
   (unless (getenv "GERBIL_PATH" #f)
     (let* ((here (path-normalize (current-directory)))
            (gerbil.pkg (path-expand "gerbil.pkg" here))
            (gerbil-path (path-expand ".gerbil" here)))
-      (when (and (file-exists? gerbil.pkg) (file-exists? gerbil-path))
+      (when (file-exists? gerbil.pkg)
+        (when (and create? (not (file-exists? gerbil-path)))
+          (create-directory gerbil-path))
         (setenv "GERBIL_PATH" gerbil-path)
         (cons-load-path (path-expand "lib" gerbil-path))))))
diff --git a/src/tools/gxensemble.ss b/src/tools/gxensemble.ss
index 301b2e90..b64d081c 100644
--- a/src/tools/gxensemble.ss
+++ b/src/tools/gxensemble.ss
@@ -24,6 +24,7 @@
   (call-with-getopt gxensemble-main args
     program: "gxensemble"
     help: "the Gerbil Actor Ensemble Manager"
+    global-env-flag
     run-cmd
     registry-cmd
     load-cmd
@@ -415,7 +416,7 @@
         gopts ...))))
 
 (def (gxensemble-main cmd opt)
-  (setup-local-env!)
+  (setup-local-env! opt)
   (dispatch-command cmd opt main-commands))
 
 (defcommand-nested do-admin admin-commands "gxensemble admin"
diff --git a/src/tools/gxpkg.ss b/src/tools/gxpkg.ss
index 827846cc..d37a74d4 100644
--- a/src/tools/gxpkg.ss
+++ b/src/tools/gxpkg.ss
@@ -33,7 +33,8 @@
         :std/sort
         (only-in :std/srfi/1 reverse!)
         (only-in :std/srfi/13 string-trim)
-        :std/sugar)
+        :std/sugar
+        ./env)
 (export main
         ;; script api
         pkg-root-dir
@@ -45,43 +46,40 @@
         pkg-plist pkg-dependents pkg-dependents*)
 
 (def (main . args)
-  (def local-flag
-    (flag 'local "-l" "--local"
-      help: "do the action in the local package context, unless GERBIL_PATH is set"))
   (def force-flag
     (flag 'force "-f" "--force"
       help: "force the action"))
   (def install-cmd
     (command 'install help: "install one or more packages"
-      local-flag
+      global-env-flag
       (rest-arguments 'pkg help: "package to install; use @tag to checkout a specific tag")))
   (def uninstall-cmd
     (command 'uninstall help: "uninstall one or more packages"
-      local-flag force-flag
+      global-env-flag force-flag
       (rest-arguments 'pkg help: "package to uninstall")))
   (def update-cmd
     (command 'update help: "update one or more packages"
-      local-flag
+      global-env-flag
       (rest-arguments 'pkg help: "package to update; use @tag to checkout a specific tag; all for all packages")))
   (def link-cmd
     (command 'link help: "link a local development package"
-      local-flag
+      global-env-flag
       (argument 'pkg help: "package to link")
       (argument 'src help: "path to package source directory")))
   (def unlink-cmd
     (command 'unlink help: "unlink one or more local development packages"
-      local-flag force-flag
+      global-env-flag force-flag
       (rest-arguments 'pkg help: "package to unlink")))
   (def build-cmd
     (command 'build help: "rebuild one or more packages and their dependents"
-      local-flag
+      global-env-flag
       (flag 'build-release "-R" "--release" help: "build released (static) executables")
       (flag 'build-optimized "-O" "--optimized" help: "build full program optimized executables")
       (flag 'build-debug "-g" "--debug" help: "build with debug symbols")
       (rest-arguments 'pkg help: "package to build; all for all packages, omit to build in current directory")))
   (def clean-cmd
     (command 'clean help: "clean compilation artefacts from one or more packages"
-      local-flag
+      global-env-flag
       (rest-arguments 'pkg help: "package to clean; all for all packages, omit to clean in current directory")))
   (def new-cmd
     (command 'new help: "create a new package template in the current directory"
@@ -105,15 +103,15 @@
         help: "the list of dependencies to add, update or remove; empty for all; if no flags are specified it displays current deps")))
   (def list-cmd
     (command 'list
-      local-flag
+      global-env-flag
       help: "list installed packages"))
   (def retag-cmd
     (command 'retag
-      local-flag
+      global-env-flag
       help: "retag installed packages"))
   (def search-cmd
     (command 'search help: "search the package directory"
-      local-flag
+      global-env-flag
       (option 'directory "-d" "--directory"
         help: "A specific directory to use; by default the mighty-gerbils directory and all user configured directories are searched")
       (flag 'as-list "--list"
@@ -122,7 +120,7 @@
 
   (def dir-cmd
     (command 'dir help: "manage the directory list"
-      local-flag
+      global-env-flag
       (flag 'add "-a" "--add"
         help: "add a directory to the list of searched directories")
       (flag 'remove "-r" "--remove"
@@ -159,36 +157,37 @@
       ((new)
        (pkg-new .package .name .link))
       ((build)
-       (build-pkgs .pkg .?build-release .?build-optimized .?build-debug .?local))
+       (build-pkgs .pkg .?build-release .?build-optimized .?build-debug .?global))
       ((clean)
-       (clean-pkgs .pkg .?local))
+       (clean-pkgs .pkg .?global))
       ((deps)
-       (manage-deps .deps .?add .?install .?update .?remove))
+       (manage-deps .deps .?add .?install .?update .?remove .?global))
       ((link)
-       (link-pkg .pkg .src .?local))
+       (link-pkg .pkg .src .?global))
       ((unlink)
-       (unlink-pkgs .pkg .?force .?local))
+       (unlink-pkgs .pkg .?force .?global))
       ((install)
-       (install-pkgs .pkg .?local))
+       (install-pkgs .pkg .?global))
       ((uninstall)
-       (uninstall-pkgs .pkg .?force .?local))
+       (uninstall-pkgs .pkg .?force .?global))
       ((update)
-       (update-pkgs .pkg .?local))
+       (update-pkgs .pkg .?global))
       ((list)
-       (list-pkgs .?local))
+       (list-pkgs .?global))
       ((retag)
-       (retag-pkgs .?local))
+       (retag-pkgs .?global))
       ((search)
        (search-pkgs .keywords .directory .?as-list))
       ((dir)
-       (manage-dirs .directories .?add .?remove .?local))
+       (manage-dirs .directories .?add .?remove .?global))
       ((env)
-       (env-exec .command .command-args)))))
+       (env-exec .command .command-args .?global)))))
 
 ;;; commands
-(def (env-exec command args)
-  (set-local-env!)
-  (set-local-path!)
+(def (env-exec command args global?)
+  (unless global?
+    (setup-local-pkg-env! #t))
+  (setup-local-path!)
   (invoke command args
           stdin-redirection: #f
           stdout-redirection: #f
@@ -210,19 +209,19 @@
    (when (fold-pkgs pkgs action action-arg ...)
      (pkg-retag))))
 
-(def (install-pkgs pkgs local?)
-  (when local?
-    (set-local-env!))
+(def (install-pkgs pkgs global?)
+  (unless global?
+    (setup-local-pkg-env! #t))
   (fold-pkgs-retag pkgs pkg-install))
 
-(def (uninstall-pkgs pkgs force? local?)
-  (when local?
-    (set-local-env!))
+(def (uninstall-pkgs pkgs force? global?)
+  (unless global?
+    (setup-local-pkg-env! #t))
   (fold-pkgs-retag pkgs pkg-uninstall force?))
 
-(def (update-pkgs pkgs local?)
-  (when local?
-    (set-local-env!))
+(def (update-pkgs pkgs global?)
+  (unless global?
+    (setup-local-pkg-env! #t))
   (when (fold-pkgs pkgs pkg-update)
     ;; the package dependencies might have changed, so install them
     (for-each
@@ -235,19 +234,19 @@
     (for-each pkg-build pkgs)
     (pkg-retag)))
 
-(def (link-pkg pkg src local?)
-  (when local?
-    (set-local-env!))
+(def (link-pkg pkg src global?)
+  (unless global?
+    (setup-local-pkg-env! #t))
   (pkg-link pkg src))
 
-(def (unlink-pkgs pkgs force? local?)
-  (when local?
-    (set-local-env!))
+(def (unlink-pkgs pkgs force? global?)
+  (unless global?
+    (setup-local-pkg-env! #t))
   (for-each (cut pkg-unlink <> force?) pkgs))
 
-(def (build-pkgs pkgs release? optimized? debug? local?)
-  (when local?
-    (set-local-env!))
+(def (build-pkgs pkgs release? optimized? debug? global?)
+  (unless global?
+    (setup-local-pkg-env! #t))
   (when release?
     (setenv "GERBIL_BUILD_RELEASE" "t"))
   (when optimized?
@@ -256,24 +255,20 @@
     (setenv "GERBIL_BUILD_DEBUG" "t"))
   (if (null? pkgs)
     ;; do local build
-    (begin
-      (set-local-env!)
-      (pkg-build "." #f))
+    (pkg-build "." #f)
     (for-each pkg-build pkgs)))
 
-(def (clean-pkgs pkgs local?)
-  (when local?
-    (set-local-env!))
+(def (clean-pkgs pkgs global?)
+  (unless global?
+    (setup-local-pkg-env! #t))
   (if (null? pkgs)
     ;; do local clean
-    (begin
-      (set-local-env!)
-      (pkg-clean "."))
+    (pkg-clean ".")
     (for-each pkg-clean pkgs)))
 
-(def (list-pkgs local?)
-  (when local?
-    (set-local-env!))
+(def (list-pkgs global?)
+  (unless global?
+    (setup-local-pkg-env! #t))
   (for (pkg (pkg-list))
     (let (tag (pkg-tag-get pkg))
       (display pkg)
@@ -281,34 +276,23 @@
         (display* "@" tag))
       (newline))))
 
-(def (retag-pkgs local?)
-  (when local?
-    (set-local-env!))
+(def (retag-pkgs global?)
+  (unless global?
+    (setup-local-pkg-env! #t))
   (pkg-retag))
 
 (def (search-pkgs keywords dir as-list?)
   (pkg-search keywords dir as-list?))
 
-(def (manage-dirs dirs add? remove? local?)
-  (pkg-directory-manage dirs add? remove? local?))
+(def (manage-dirs dirs add? remove? global?)
+  (pkg-directory-manage dirs add? remove? global?))
 
-(def (manage-deps deps add? install? update? remove?)
-  (set-local-env!)
+(def (manage-deps deps add? install? update? remove? global?)
+  (unless global?
+    (setup-local-pkg-env! #t))
   (pkg-deps-manage deps add? install? update? remove?))
 
-(def (set-local-env!)
-  (unless (getenv "GERBIL_PATH" #f)
-    (let* ((here (path-normalize* (current-directory)))
-           (gerbil-path (path-expand ".gerbil" here)))
-      (if (file-exists? gerbil-path)
-        (setenv "GERBIL_PATH" gerbil-path)
-        (if (file-exists? (path-expand "gerbil.pkg" here))
-          (begin
-            (create-directory* gerbil-path)
-            (setenv "GERBIL_PATH" gerbil-path))
-          (error "not in local package context"))))))
-
-(def (set-local-path!)
+(def (setup-local-path!)
   (let* (($GERBIL_PATH (gerbil-path))
          ($PATH (getenv "PATH"))
          ($PATH (string-append $GERBIL_PATH "/bin" ":" $PATH)))
@@ -828,11 +812,11 @@
 (def (pkg-directory-local-dirs)
   (pkg-directory-user-dirs pkg-directory-local-dirs-path))
 
-(def (pkg-directory-dirs-add add-dirs local?)
+(def (pkg-directory-dirs-add add-dirs global?)
   (let* ((current
-          (if local?
-            (pkg-directory-local-dirs)
-            (pkg-directory-user-dirs)))
+          (if global?
+            (pkg-directory-user-dirs)
+            (pkg-directory-local-dirs)))
          (new
           (let lp ((rest add-dirs) (new []))
             (match rest
@@ -845,16 +829,16 @@
                (remove-duplicates
                 (append current (reverse new))))))))
     (call-with-output-file
-        (if local?
-          (pkg-directory-local-dirs-path)
-          (pkg-directory-user-dirs-path))
+        (if global?
+          (pkg-directory-user-dirs-path)
+          (pkg-directory-local-dirs-path))
       (cut write new <>))))
 
-(def (pkg-directory-dirs-remove remove-dirs local?)
+(def (pkg-directory-dirs-remove remove-dirs global?)
   (let* ((current
-          (if local?
-            (pkg-directory-local-dirs)
-            (pkg-directory-user-dirs)))
+          (if global?
+            (pkg-directory-user-dirs)
+            (pkg-directory-local-dirs)))
          (new
           (let lp ((rest current) (new []))
             (match rest
@@ -865,9 +849,9 @@
               (else
                (reverse new))))))
     (call-with-output-file
-        (if local?
-          (pkg-directory-local-dirs-path)
-          (pkg-directory-user-dirs-path))
+        (if global?
+          (pkg-directory-user-dirs-path)
+          (pkg-directory-local-dirs-path))
       (cut write new <>))))
 
 (def (pkg-directory-urls)
@@ -907,7 +891,7 @@
       (error "error retrieving packages" url (request-status-text req)))))
 
 ;; package directory management
-(def (pkg-directory-manage dirs add? remove? local?)
+(def (pkg-directory-manage dirs add? remove? global?)
   (cond
    ((null? dirs)
     (if (or add? remove?)
@@ -921,9 +905,9 @@
    ((and add? remove?)
     (error "do you want to add or remove"))
    (add?
-    (pkg-directory-dirs-add dirs local?))
+    (pkg-directory-dirs-add dirs global?))
    (remove?
-    (pkg-directory-dirs-remove dirs local?))
+    (pkg-directory-dirs-remove dirs global?))
    (else
     (for (dir dirs)
       (pretty-print (pkg-directory-list dir))))))
diff --git a/src/tools/gxprof.ss b/src/tools/gxprof.ss
index 960f16dc..10832cf4 100644
--- a/src/tools/gxprof.ss
+++ b/src/tools/gxprof.ss
@@ -19,6 +19,7 @@
   (call-with-getopt gxprof-main args
     program: "gxprof"
     help: "The Gerbil profiler"
+    global-env-flag
     (option 'output "-o" "--output"
       help: "gxprof output file"
       default: "gxprof.out")
@@ -34,7 +35,7 @@
       help: "arguments to pass to the executable module's main")))
 
 (def (gxprof-main opt)
-  (setup-local-env!)
+  (setup-local-env! opt)
   (let-hash opt
     (if .?module
       (let* ((ctx (import-module (module-path .module) #f #t))
diff --git a/src/tools/gxtags.ss b/src/tools/gxtags.ss
index f54fb039..84a51deb 100644
--- a/src/tools/gxtags.ss
+++ b/src/tools/gxtags.ss
@@ -22,6 +22,7 @@
   (call-with-getopt gxtags-main args
     program: "gxtags"
     help: "generate emacs/vim tags for Gerbil code"
+    global-env-flag
     (flag 'append "-a"
       help: "append to existing tag file")
     (option 'output "-o" default: "TAGS"
@@ -34,7 +35,7 @@
       help: "source file or directory")))
 
 (def (gxtags-main opt)
-  (setup-local-env!)
+  (setup-local-env! opt)
   (run (hash-ref opt 'input ["."])
        (hash-get opt 'output)
        (hash-get opt 'append)
diff --git a/src/tools/gxtest.ss b/src/tools/gxtest.ss
index 1fc6e84f..74b0e858 100644
--- a/src/tools/gxtest.ss
+++ b/src/tools/gxtest.ss
@@ -18,18 +18,19 @@
   (call-with-getopt gxtest-main args
     program: "gxtest"
     help: "run Gerbil tests in the command line"
-     (flag 'verbose "-v"
+    global-env-flag
+    (flag 'verbose "-v"
            help: "run in verbose mode where all test execution progress is displayed in stdout.")
-     (option 'run "-r" "--run"
-             help: "only run test suites whose name matches a given regex")
+    (option 'run "-r" "--run"
+            help: "only run test suites whose name matches a given regex")
      ;; TODO this should be a multi-option for multiple features
-     (option 'features "-D"
-             help: "define one or more conditional expansion feature (comma separated) for enabling tests that require external services")
-     (rest-arguments 'args
-                     help: "test files or directories to execute tests in; appending /... to a directory will recursively execute or tests in it. If no arguments are passed, all tests in the current directory are executed.")))
+    (option 'features "-D"
+            help: "define one or more conditional expansion feature (comma separated) for enabling tests that require external services")
+    (rest-arguments 'args
+                    help: "test files or directories to execute tests in; appending /... to a directory will recursively execute or tests in it. If no arguments are passed, all tests in the current directory are executed.")))
 
 (def (gxtest-main opt)
-  (setup-local-env!)
+  (setup-local-env! opt)
   (let-hash opt
     (cond
      ((null? .args)