1. carl douglas
  2. git-egg-author

Commits

Comments (0)

Files changed (6)

File git-egg-author.meta Added

View file
  • Ignore whitespace
  • Hide word diff
+((synopsis "A small egg to make life easier for git-using authors of Chicken eggs")
+ (category egg-tools)
+ (author "Peter Bex" "A. Carl Douglas")
+ (doc-from-wiki)
+ (license "Public Domain")
+ (depends ssax sxpath)
+ (files "git-egg-author.meta" "git-egg-author.release-info" "git-egg-author.setup" "git-eggtag.scm" "git-update-meta.scm"))

File git-egg-author.setup Added

View file
  • Ignore whitespace
  • Hide word diff
+;; -*- Scheme -*-
+
+(define version "0.1.3")
+
+(compile -O3 -d0 git-update-meta.scm)
+(install-program
+ `git-update-meta
+ `("git-update-meta")
+ `((version ,version)))
+
+(compile -O3 -d0 git-eggtag.scm)
+(install-program
+ `git-eggtag
+ `("git-eggtag")
+ `((version ,version)))

File svn-eggtag.scm → git-eggtag.scm (60% similar) Renamed

View file
  • Ignore whitespace
  • Hide word diff
-(use setup-api posix ssax sxpath sxpath-lolevel files utils)
+(use setup-api posix files utils irregex)
 
 (define (usage code)
   (print #<#EOF
-usage: svn-eggtag [-n] RELEASE
+usage: git-eggtag [-n] RELEASE
 
   -h   -help                    Show this message
   -n   -no-update               No meta-file update
 
-svn-eggtag will tag an egg for release with the name RELEASE and add a
+git-eggtag will tag an egg for release with the name RELEASE and add a
 corresponding entry to the .release-info file.  It will also update
 the .meta-file's FILES section to contain all the files, unless -n is
 passed.
       (error "Got an error while executing command " cmd))
     res))
 
-(define (svn-xml cmd)
-  (call-with-input-pipe* cmd (lambda (i) (ssax:xml->sxml i '()))))
-
-(define (find-root-url)
-  (let ((info (svn-xml "svn info --xml")))
-    (let lp ((url ((if-car-sxpath '(info entry url *text*)) info)))
-      (cond
-       ((or (not url) (string=? url ""))
-        (fprintf (current-error-port)
-                 "Could not figure out root URL; Please run from the 'trunk' of your egg")
-        (exit 1))
-       ((and (string? (pathname-file url))
-             (string=? (pathname-file url) "trunk"))
-        (pathname-directory url))
-       (else (lp (pathname-directory url)))))))
+(define (git-exec cmd)
+  (call-with-input-pipe* cmd read-lines ))
+
+(define (irregex-grep irx lines)
+  (map (lambda(line)
+         (irregex-search irx line)) lines))
+
+(define (find-egg-name)
+  (let ((meta-file (car (glob "*.meta"))))
+    (cond ((null? meta-file)
+           (fprintf (current-error-port)
+                    "Error: No meta file found! Please create one first~%")
+           (exit 1)
+          ((> (length meta-file) 1)
+           (fprintf (current-error-port)
+                    "Error: ~A meta files found. Can only deal with one!~%"
+                    (length meta-file))
+           (exit 1))
+          (else (pathname-file meta-file))))))
 
 (define (ensure-clean-wc!)
-  (let ((status (svn-xml "svn status --xml"))) ; -q doesn't work with --xml :(
-    (when ((if-car-sxpath `(status target entry wc-status
-                                   ;; There has to be a better way :(
-                                   ,(lambda (x y)
-                                      ((sxml:filter
-                                        (lambda (x)
-                                          (let ((s ((sxpath '(@ item)) x)))
-                                            (not (string=? (sxml:text s)
-                                                           "unversioned"))))) x))))
-           status)
+  (let ((status (git-exec "git status --porcelain")))
+    (when (any values (irregex-grep "^ M" status))
       (fprintf (current-error-port)
                (conc "Working copy is not clean. Please commit all outstanding "
                      "changes before tagging a release!~%"))
              (lambda () (write `(release ,release-version)) (newline))
              #:append)))))
 
-(define (copy-to-tags! egg-name root-url release-version)
-  (let ((trunkdir (sprintf "~A/trunk" root-url))
-        (tagdir   (sprintf "~A/tags/~A" root-url release-version)))
-   (printf "Copying ~A\nto      ~A\n" trunkdir tagdir)
-   (system* "svn copy --parents -m ~A ~A ~A"
-            (qs (sprintf "~A: Tag release ~A" egg-name release-version))
-            (qs trunkdir)
-            (qs tagdir))))
-
-(define (check-tag-does-not-exist! root-url release-version)
-  (when (and ((if-car-sxpath `(// name (equal? "tags")))
-              (svn-xml (sprintf "svn ls --xml ~A" (qs root-url))))
-             ((if-car-sxpath `(// name (equal? ,release-version)))
-              (svn-xml (sprintf "svn ls --xml ~A/tags" (qs root-url)))))
+(define (check-tag-does-not-exist! release-version)
+  (when (any values (irregex-grep release-version (git-exec "git tag")))
     (fprintf (current-error-port)
              "There's already a tag that matches your release version ~S!~%"
              release-version)
     (exit 1)))
 
 (define (commit-all! egg-name release-version)
-  (system* "svn commit -m ~A ~A ~A"
+  (system* "git commit -m ~A ~A ~A"
            (qs (sprintf "~A: Add release ~A" egg-name release-version))
            (qs (car (glob "*.release-info")))
            (if *update-meta-file* (qs (car (glob "*.meta"))) "")))
 
-(define (update-to-latest!)
-  (system* "svn update"))
+(define (push-all!)
+  (system* "git push --tags --all"))
 
 (define (tag-egg release-version)
-  (let* ((root-url (find-root-url))
-         (egg-name (or (pathname-file root-url)
-                       (pathname-file (pathname-directory root-url)))))
+  (let* ((egg-name (find-egg-name)))
+    (pp egg-name)
     (ensure-clean-wc!)
-    (check-tag-does-not-exist! root-url release-version)
+    (check-tag-does-not-exist! release-version)
     (update-release-info! release-version)
     (when *update-meta-file* (update-meta!))
     (commit-all! egg-name release-version)
-    (copy-to-tags! egg-name root-url release-version)
-    (update-to-latest!)))
+    (push-all!)))
 
 (define *update-meta-file* #t)
 

File svn-update-meta.scm → git-update-meta.scm (81% similar) Renamed

View file
  • Ignore whitespace
  • Hide word diff
-(use posix ssax sxpath sxpath-lolevel files)
+(use posix files)
 
 (define (usage code)
   (print #<#EOF
-usage: svn-update-meta
+usage: git-update-meta
 
   -h   -help                    Show this message
 
-svn-update-meta will ask Subversion for all files that are managed by
+git-update-meta will ask Git for all files that are managed by
 it and put those in the meta-file's FILES entry.  Files that are
 unversioned are ignored.
 
       (error "Got an error while executing command " cmd))
     res))
 
-(define (svn-xml cmd)
-  (call-with-input-pipe* cmd (lambda (i) (ssax:xml->sxml i '()))))
+(define (git-exec cmd)
+  (call-with-input-pipe* cmd read-lines ))
 
 (define (ensure-meta-file-exists!)
   (let* ((metas (glob "*.meta")))
                   (display (substring meta-data (sub1 end)))))))))))
 
 (define (list-egg-files)
-  (remove directory?
-          ((sxpath `(status target
-                            (entry (wc-status
-                                    ;; There has to be a better way :(
-                                    ,(lambda (x y)
-                                       ((sxml:filter
-                                         (lambda (x)
-                                           (let ((s ((sxpath '(@ item)) x)))
-                                             (not (string=? (sxml:text s)
-                                                            "unversioned"))))) x))))
-                            @ path (*text* 1)))
-           (svn-xml "svn status -v --xml"))))
+  (git-exec "git ls-files"))
 
 (define *short-options* '(#\h))
 

File svn-egg-author.meta Deleted

  • Ignore whitespace
  • Hide word diff
-((synopsis "A small egg to make life easier for svn-using authors of Chicken eggs")
- (category egg-tools)
- (author "Peter Bex")
- (doc-from-wiki)
- (license "Public Domain")
- (depends ssax sxpath)
- (files "svn-egg-author.meta" "svn-egg-author.release-info" "svn-egg-author.setup" "svn-eggtag.scm" "svn-update-meta.scm"))

File svn-egg-author.setup Deleted

  • Ignore whitespace
  • Hide word diff
-;; -*- Scheme -*-
-
-(define version "0.1.3")
-
-(compile -O3 -d0 svn-update-meta.scm)
-(install-program
- `svn-update-meta
- `("svn-update-meta")
- `((version ,version)))
-
-(compile -O3 -d0 svn-eggtag.scm)
-(install-program
- `svn-eggtag
- `("svn-eggtag")
- `((version ,version)))