~ chicken-core (chicken-5) /scripts/makedist.scm

  1;;;; makedist.scm - Make distribution tarballs
  2
  3
  4(import (chicken file)
  5        (chicken fixnum)
  6        (chicken format)
  7        (chicken io)
  8        (chicken irregex)
  9        (chicken pathname)
 10        (chicken platform)
 11        (chicken process)
 12        (chicken process-context)
 13        (chicken string))
 14
 15(include "mini-srfi-1.scm")
 16
 17(define *release* #f)
 18(define *help* #f)
 19
 20(define BUILDVERSION (with-input-from-file "buildversion" read))
 21
 22(define *platform* 
 23  (let ((sv (symbol->string (software-version))))
 24    (cond ((irregex-match ".*bsd" sv) "bsd")
 25	  ((string=? sv "mingw32")
 26	   (if (equal? (get-environment-variable "MSYSTEM") "MINGW32")
 27	       "mingw-msys"
 28	       "mingw32"))
 29	  (else sv))))
 30
 31(define *make* 
 32  (cond ((string=? "bsd" *platform*) "gmake")
 33	((string=? "mingw32" *platform*) "mingw32-make")
 34	(else "make")))
 35
 36(define (prefix dir . files)
 37  (if (null? files)
 38      (pathname-directory dir)
 39      (let ((files2 (map (cut make-pathname dir <>) (normalize files))))
 40	(if (or (pair? (cdr files)) (pair? (car files)))
 41	    files2
 42	    (car files2) ) ) ) )
 43
 44(define (normalize fs)
 45  (delete-duplicates
 46   (map ->string
 47	(if (pair? fs)
 48	    (flatten fs)
 49	    (list fs) ) )
 50   equal?) )
 51
 52(define (run . args)
 53  (let ((cmd (apply format args)))
 54    (display cmd (current-error-port))
 55    (newline (current-error-port))
 56    (system* cmd)))
 57
 58(define (release full?)
 59  (let* ((files (with-input-from-file "distribution/manifest" read-lines))
 60	 (distname (conc "chicken-" BUILDVERSION)) 
 61	 (distfiles (map (cut prefix distname <>) files)) 
 62	 (tgz (conc distname ".tar.gz")))
 63    (run "rm -fr ~a ~a" distname tgz)
 64    (create-directory distname)
 65    (for-each
 66     (lambda (d)
 67       (let ((d (make-pathname distname d)))
 68	 (unless (file-exists? d)
 69	   (print "creating " d)
 70	   (create-directory d 'with-parents))))
 71     (delete-duplicates (filter-map prefix files) string=?))
 72    (let ((missing
 73	   (foldl (lambda (missing f)
 74		    (cond
 75		     ((file-exists? f)
 76		      (run "cp -p ~a ~a" (qs f) (qs (make-pathname distname f)))
 77		      missing)
 78		     (else (cons f missing))))
 79		  '() files)))
 80      (unless (null? missing)
 81	(warning "files missing" missing) ) )
 82    (run "tar cfz ~a ~a" (conc distname ".tar.gz") distname)
 83    (run "rm -fr ~a" distname)))
 84
 85(define (usage)
 86  (print "usage: makedist [-release] [-make PROGRAM] [--platform=PLATFORM] MAKEOPTION ...")
 87  (exit))
 88
 89(define *makeargs*
 90  (let loop ((args (command-line-arguments)))
 91    (if (null? args)
 92	'()
 93	(let ((arg (car args)))
 94	  (cond ((string=? "-release" arg) 
 95		 (set! *release* #t)
 96		 (loop (cdr args)))
 97		((string=? "-make" arg)
 98		 (set! *make* (cadr args))
 99		 (loop (cddr args)))
100		((string=? "-help" arg)
101		 (usage))
102		((string=? "-platform" arg)
103		 (set! *platform* (cadr args))
104		 (loop (cddr args)))
105		(else (cons arg (loop (cdr args)))))))))
106
107(run "~a -f Makefile.~a distfiles ~a" *make* *platform* (string-intersperse *makeargs*))
108
109(release *release*)