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