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

v4-ized, and use "mzscheme.exe" on cygwin

Browse Source 
svn: r11364
This commit is contained in:
Eli Barzilay 2008-08-21 09:55:37 +00:00
parent e0a00155bd
commit a8ce7f6fe3
1 changed files with 24 additions and 31 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

55
collects/setup/variant.ss
View File

@ -1,35 +1,28 @@
#lang scheme/base
(module variant mzscheme
(require (prefix config: config)
setup/dirs)
(require (prefix-in config: config) setup/dirs scheme/promise)
(provide variant-suffix)
(provide variant-suffix)
(define plain-mz-is-cgc?
(delay (let ([dir (find-console-bin-dir)]
[exe (case (system-type)
[(windows) "MzScheme.exe"]
[else "mzscheme"])])
(let ([f (build-path dir exe)])
(and (file-exists? f)
(with-input-from-file f
(lambda ()
(let ([m (regexp-match #rx#"bINARy tYPe:..(.)" (current-input-port))])
(and m
(equal? (cadr m) #"c"))))))))))
(define plain-mz-is-cgc?
(delay (let* ([dir (find-console-bin-dir)]
[exe (cond [(eq? 'windows (system-type)) '("MzScheme.exe")]
[(equal? #".dll" (system-type 'so-suffix))
;; in cygwin so-suffix is ".dll"
"mzscheme.exe"]
[else "mzscheme"])]
[f (build-path dir exe)])
(and (file-exists? f)
(with-input-from-file f
(lambda ()
(regexp-match? #rx#"bINARy tYPe:..c"
(current-input-port))))))))
(define variant-suffix
(lambda (variant cased?)
(case variant
[(3m script-3m)
((if cased? values string-downcase)
(or (force config:3m-suffix)
(if (force plain-mz-is-cgc?)
"3m"
"")))]
[(cgc script-cgc)
((if cased? values string-downcase)
(or (force config:cgc-suffix)
(if (force plain-mz-is-cgc?)
""
"CGC")))]))))
(define (variant-suffix variant cased?)
(let ([r (case variant
[(3m script-3m) (or (force config:3m-suffix)
(if (force plain-mz-is-cgc?) "3m" ""))]
[(cgc script-cgc) (or (force config:cgc-suffix)
(if (force plain-mz-is-cgc?) "" "CGC"))]
[else (error 'variant-suffix "unknown variant: ~e" variant)])])
(if cased? r (string-downcase r))))