suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

mzscheme -> scheme

Browse Source 
svn: r16239
This commit is contained in:
Eli Barzilay 2009-10-05 04:34:04 +00:00
parent 337061d8c4
commit b0e8fac1f8
1 changed files with 40 additions and 46 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

86
collects/setup/winvers.ss
View File

@ -1,54 +1,48 @@
;; This is a wrapper around `winvers-change.ss' to patch binary files with the ;; This is a wrapper around `winvers-change.ss' to patch binary files with the
;; current version number. ;; current version number.
(module winvers mzscheme #lang scheme
(require mzlib/file (require mzlib/file "main-collects.ss" "dirs.ss")
"main-collects.ss"
"dirs.ss")
(define (make-copy) (define (make-copy)
(let* ([tmpdir (find-system-path 'temp-dir)] (let* ([tmpdir (find-system-path 'temp-dir)]
[vers (build-path tmpdir "setvers")]) [vers (build-path tmpdir "setvers")])
(unless (directory-exists? vers) (make-directory vers)) (unless (directory-exists? vers) (make-directory vers))
(for-each (lambda (p) (for ([p (in-list '("mzscheme.exe" "lib"))])
(let ([dest (build-path vers p)]) (let ([dest (build-path vers p)])
((cond [(file-exists? dest) delete-file] ((cond [(file-exists? dest) delete-file]
[(directory-exists? dest) delete-directory/files] [(directory-exists? dest) delete-directory/files]
[else void]) [else void])
dest) dest)
(copy-directory/files (build-path (find-console-bin-dir) p) (copy-directory/files (build-path (find-console-bin-dir) p) dest)))
dest))) (build-path vers "mzscheme.exe")))
'("mzscheme.exe" "lib"))
(build-path vers "mzscheme.exe")))
(define (patch-files) (define (patch-files)
(parameterize ((current-command-line-arguments (parameterize ([current-command-line-arguments
(vector (path->string (find-console-bin-dir))))) (vector (path->string (find-console-bin-dir)))])
(dynamic-require 'setup/winvers-change #f))) (dynamic-require 'setup/winvers-change #f)))
(define collects-dir (define collects-dir
(path->string (find-collects-dir))) (path->string (find-collects-dir)))
(let ([argv (current-command-line-arguments)]) (let ([argv (current-command-line-arguments)])
(cond (cond [(equal? argv #())
[(equal? argv #()) (let ([exe (make-copy)])
(let ([exe (make-copy)]) (printf "re-launching first time...~n")
(printf "re-launching first time...~n") (subprocess
(current-output-port) (current-input-port) (current-error-port)
exe "--collects" collects-dir
"-l" "setup/winvers" "patch"))]
[(equal? argv #("patch"))
(sleep 1) ; time for other process to end
(patch-files)
(printf "re-launching last time...~n")
(subprocess (subprocess
(current-output-port) (current-input-port) (current-error-port) (current-output-port) (current-input-port) (current-error-port)
exe "--collects" collects-dir (build-path (find-console-bin-dir) "mzscheme.exe")
"-l" "setup/winvers" "patch"))] "-l" "setup/winvers" "finish")]
[(equal? argv #("patch")) [(equal? argv #("finish"))
(sleep 1) ; time for other process to end (sleep 1) ; time for other process to end
(patch-files) (delete-directory/files
(printf "re-launching last time...~n") (build-path (find-system-path 'temp-dir) "setvers"))
(subprocess (printf "done!~n")]
(current-output-port) (current-input-port) (current-error-port) [else (error 'winvers "unknown command line: ~e" argv)]))
(build-path (find-console-bin-dir) "mzscheme.exe")
"-l" "setup/winvers" "finish")]
[(equal? argv #("finish"))
(sleep 1) ; time for other process to end
(delete-directory/files
(build-path (find-system-path 'temp-dir) "setvers"))
(printf "done!~n")]
[else
(error 'winvers "unknown command line: ~e" argv)])))