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

use --script when relaunching copy

Browse Source 
svn: r2753
This commit is contained in:
Eli Barzilay 2006-04-23 22:25:34 +00:00
parent 5c39160ebd
commit 152ece97bc
1 changed files with 15 additions and 15 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

30
collects/setup/winvers.ss
View File

@ -1,28 +1,27 @@
;; 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 (module winvers mzscheme
(require (lib "file.ss") (require (lib "file.ss") "plthome.ss")
"plthome.ss")
(define (make-copy) (define (make-copy)
(let ([tmpdir (find-system-path 'temp-dir)]) (let* ([tmpdir (find-system-path 'temp-dir)]
(let ([vers (build-path tmpdir "setvers")]) [vers (build-path tmpdir "setvers")])
(unless (directory-exists? vers) (unless (directory-exists? vers) (make-directory vers))
(make-directory vers)) (for-each (lambda (p)
(for-each (let ([dest (build-path vers p)])
(lambda (p) (when (file-exists? dest) (delete-file dest))
(let ([dest (build-path vers p)]) (copy-file (build-path plthome p) dest)))
(when (file-exists? dest) '("mzscheme.exe" "libmzgcxxxxxxx.dll" "libmzschxxxxxxx.dll"))
(delete-file dest)) (build-path vers "mzscheme.exe")))
(copy-file (build-path plthome p) dest)))
'("mzscheme.exe" "libmzgcxxxxxxx.dll" "libmzschxxxxxxx.dll"))
(build-path vers "mzscheme.exe"))))
(define (patch-files) (define (patch-files)
(parameterize ((current-command-line-arguments (parameterize ((current-command-line-arguments
(vector (path->string plthome)))) (vector (path->string plthome))))
(dynamic-require `(lib "winvers-change.ss" "setup") #f))) (dynamic-require `(lib "winvers-change.ss" "setup") #f)))
(define collects-dir
(path->string (simplify-path (build-path (collection-path "mzlib") 'up))))
(let ([argv (current-command-line-arguments)]) (let ([argv (current-command-line-arguments)])
(cond (cond
[(equal? argv #()) [(equal? argv #())
@ -31,7 +30,8 @@
(printf "re-launching first time...~n") (printf "re-launching first time...~n")
(subprocess (subprocess
(current-output-port) (current-input-port) (current-error-port) (current-output-port) (current-input-port) (current-error-port)
exe "-mvqL-" "winvers.ss" "setup" "patch"))] exe "--collects" collects-dir
"-mvqL-" "winvers.ss" "setup" "patch"))]
[(equal? argv #("patch")) [(equal? argv #("patch"))
(sleep 1) ; time for other process to end (sleep 1) ; time for other process to end
(patch-files) (patch-files)