devops: changes should be #f initially. Use empty tag message.

diff --git a/src/devops/devops.scm b/src/devops/devops.scm
index d91b52df52163aa5f3c9c4a557aa4578a302db18..02f45aa79bc4f92d01c116bc616d55f4df3db299 100644 (file)
--- a/src/devops/devops.scm
+++ b/src/devops/devops.scm
@@ -35,7 +35,7 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA.
 
 (define (core-status dirt)
   (let* ((version (core-version))
-        (lint (core-lint version (core-changes) dirt)))
+        (lint (core-lint version (or (core-changes) '()) dirt)))
     (if (not (null? lint))
        (begin
          (log "# "(project-name)" "(version-string version)":\n")
@@ -116,7 +116,7 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA.
 (define (released-version-lint version released changes)
   (cond ((eq? #f released)
         (list "First release!"))
-       ((and (not (null? changes))
+       ((and (pair? changes)
              (not (version>? version released)))
         (list "Version is out-of-date."))
        (else
@@ -178,21 +178,24 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA.
 
 (define (core-changes)
   (let ((start-hash (released-hash (project-name))))
-    (append-map!
-     (lambda (hash)
-       (let* ((lines (shell-lines "git log --oneline --name-status -1 "hash))
-             (files (filter (let ((excludes (plugin-dir-prefixes)))
-                              (lambda (line)
-                                (let* ((i (string-find-next-char line #\tab))
-                                       (name (substring line (fix:1+ i))))
-                                  (not (any (lambda (exclude)
-                                              (string-prefix? exclude name))
-                                            excludes)))))
-                            (cdr lines))))
-        (if (null? files)
-            '()
-            (cons (car lines) files))))
-     (shell-lines "git log --format=%H "start-hash"..HEAD"))))
+    (and start-hash
+        (append-map!
+         (lambda (hash)
+           (let* ((lines
+                   (shell-lines "git log --oneline --name-status -1 "hash))
+                  (files
+                   (filter (let ((excludes (plugin-dir-prefixes)))
+                             (lambda (line)
+                               (let* ((i (string-find-next-char line #\tab))
+                                      (name (substring line (fix:1+ i))))
+                                 (not (any (lambda (exclude)
+                                             (string-prefix? exclude name))
+                                           excludes)))))
+                           (cdr lines))))
+             (if (null? files)
+                 '()
+                 (cons (car lines) files))))
+         (shell-lines "git log --format=%H "start-hash"..HEAD")))))
 
 #;(define (core-changed-files)
   (let ((hash (released-hash (project-name))))
@@ -241,10 +244,9 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA.
 
 (define (plugin-changes plugin)
   (let ((hash (released-hash (plugin-package plugin))))
-    (if hash
-       (shell-lines "git log --oneline --name-status "hash".."
-                    " -- "(plugin-directory plugin)"/")
-       '())))
+    (and hash
+        (shell-lines "git log --oneline --name-status "hash".."
+                     " -- "(plugin-directory plugin)"/"))))
 
 #;(define (plugin-changed-files plugin)
   (let ((hash (released-hash (plugin-package plugin))))
@@ -259,7 +261,7 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA.
 (define (devops:release #!optional plugin)
   (let ((dirt (shell-lines "git status --porcelain --untracked-files=no")))
     (cond ((default-object? plugin)
-          (release-core dirt #f))
+          (release-core (core-version) (core-changes) dirt #f))
          ((or (equal? "snapshot" plugin)
               (eq? 'snapshot plugin))
           (snapshot-core dirt)
@@ -269,7 +271,7 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA.
           (let* ((name (string plugin))
                  (p (find (lambda (p) (string=? name (plugin-name p)))
                           (plugins))))
-            (release-plugin p dirt #f)))
+            (release-plugin p (plugin-version p) (plugin-changes p) dirt #f)))
          (else
           (error "Plugin must be a string or symbol.")))))
 
@@ -289,10 +291,8 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA.
        (if snap?
           (run "git archive --prefix="project"/ HEAD"
                " | ( cd devops/"pkgvers" && tar xf - )")
-          (let ((hash (car (shell-lines "git log --format=%H -1 HEAD")))
-                (datime
-                 (universal-time->local-time-string (get-universal-time))))
-            (run "git tag -s -m \""datime" "hash"\" "pkgvers)
+          (begin
+            (run "git tag -s -m \"\" "pkgvers)
             (run "git archive --prefix="project"/ "pkgvers
                  " | ( cd devops/"pkgvers" && tar xf - )")))
        (run "cd devops/"pkgvers" && "project"/dist/make-src-files standard")
@@ -321,10 +321,8 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA.
        (if snap?
           (run "git archive --prefix="pkgvers"/ HEAD -- "dir
                " | ( cd devops && tar xf - )")
-          (let ((hash (car (shell-lines "git log --format=%H -1 HEAD")))
-                (datime
-                 (universal-time->local-time-string (get-universal-time))))
-            (run "git tag -s -m \""datime" "hash"\" "pkgvers)
+          (begin
+            (run "git tag -s -m \"\" "pkgvers)
             (run "git archive --prefix="pkgvers"/ "pkgvers" -- "dir
                  " | ( cd devops && tar xf - )")))
        (run "cd devops/"pkgvers"/"dir" && ./autogen.sh")
@@ -364,7 +362,7 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA.
           (error "version has not incremented:" version)))))
 
 (define (snapshot-plugin plugin dirt)
-  (let* ((changes (plugin-changes plugin))
+  (let* ((changes (or (plugin-changes plugin) '()))
         (version (plugin-version plugin))
         (released (released-version (plugin-package plugin)))
         (vers (version-string version))