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