From: Matt Birkholz <matt@birchwood-abbey.net>
Date: Sat, 17 Mar 2018 19:59:20 +0000 (-0700)
Subject: devops/devops: Add tag-options.  Make only public (devops) bindings.
X-Git-Tag: mit-scheme-pucked-x11-0.2.2~27
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=74456e4a1689229120f7477d10f6e7d04ff09415;p=mit-scheme.git

devops/devops: Add tag-options.  Make only public (devops) bindings.
---

diff --git a/src/devops/build.texi b/src/devops/build.texi
index c2b200640..291c4cbc0 100644
--- a/src/devops/build.texi
+++ b/src/devops/build.texi
@@ -107,11 +107,11 @@ strings.
 
 @deffn Procedure make-configuration . options
 @var{Options} should be a list of strings to be passed as arguments to
-the @code{./configure} scripts of the core and plugins.
+the @code{./configure} scripts of the core and plugins.  They are
+not shell escaped.  A space is inserted between them.
 @end deffn
 
 An example @file{devops-config.scm} file:
-
 @smallexample
 ;; Shared configuration.
 (load (merge-pathnames "devops/config.scm"
@@ -202,6 +202,12 @@ Warn of unclean files, lint, or other possible trouble, but tag
 (or core) but no git tags.
 @end deffn
 
+@deffn Procedure tag-options . options
+@var{Options} should be a list of strings to be passed as arguments in
+the @code{git tag} shell command line used to tag a release.  They are
+not shell escaped.  A space is inserted between them.
+@end deffn
+
 @node Build Process
 @section Build Process
 
diff --git a/src/devops/devops.pkg b/src/devops/devops.pkg
index fc705b0c5..825f92899 100644
--- a/src/devops/devops.pkg
+++ b/src/devops/devops.pkg
@@ -31,16 +31,26 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA.
   (files "build"))
 
 (define-package (devops)
+  (parent ()))
+
+(define-package (devops main)
   (parent (devops build))
   (files "devops")
   (export ()
 	  devops:status
 	  devops:release
 	  devops:build
-	  devops:make))
+	  devops:make)
+  (export (devops)
+	  host
+	  main
+	  plugin
+	  project-name
+	  tag-options
+	  make-configuration))
 
 (define-package (devops lint)
-  (parent (devops))
+  (parent (devops main))
   (files "lint")
   (export (devops)
 	  plugin-deffn-lint)
diff --git a/src/devops/devops.scm b/src/devops/devops.scm
index 6d9f3e2cc..07d92f34d 100644
--- a/src/devops/devops.scm
+++ b/src/devops/devops.scm
@@ -24,7 +24,7 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA.
 
 ;;; See devops.texi for complete details.
 
-(define (devops:main)
+(define (main)
   (let* ((cmdl (command-line))
 	 (arg1 (and (pair? cmdl) (car cmdl))))
     (cond ((equal? arg1 "status") (apply devops:status (cdr cmdl)))
@@ -371,7 +371,13 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA.
 
 ;;;; Release
 
-(define git-tag-create-options "")
+(define tag-create-options "")
+
+(define (tag-options . options)
+  (guarantee-list-of string? options 'tag-options)
+  (if (not (null? options))
+      (set! tag-create-options ((string-joiner* 'infix " ") options)))
+  tag-create-options)
 
 (define (devops:release #!optional plugin)
   (load "devops/config.scm")
@@ -408,7 +414,7 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA.
 	   (runl "git archive --prefix="project"/ HEAD"
 		 " | ( cd devops/"pkgvers" && tar xf - )")
 	   (begin
-	     (runl "git tag "git-tag-create-options" -m \"\" "pkgvers)
+	     (runl "git tag "tag-create-options" -m \"\" "pkgvers)
 	     (runl "git archive --prefix="project"/ "pkgvers
 		   " | ( cd devops/"pkgvers" && tar xf - )")))
        (runl "cd devops/"pkgvers" && "project"/dist/make-src-files standard")
@@ -446,7 +452,7 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA.
 	   (runl "git archive --prefix="pkgvers"/ HEAD -- "dir
 		 " | ( cd devops && tar xf - )")
 	   (begin
-	     (runl "git tag "git-tag-create-options" -m \"\" "pkgvers)
+	     (runl "git tag "tag-create-options" -m \"\" "pkgvers)
 	     (runl "git archive --prefix="pkgvers"/ "pkgvers" -- "dir
 		   " | ( cd devops && tar xf - )")))
        (runl "cd devops/"pkgvers"/"dir" && ./autogen.sh")
@@ -872,12 +878,9 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA.
 
 (define make-config "")
 (define (make-configuration . args)
+  (guarantee-list-of string? args 'make-configuration)
   (if (not (null? args))
-      (begin
-	(if (not (list-of-type? args string?))
-	    (error:wrong-type-argument args "list of strings"
-				       'make-configuration))
-	(set! make-config (decorated-string-append "" " " "" args))))
+      (set! make-config ((string-joiner* 'infix " ") args)))
   make-config)
 
 (define (lndir dest)