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

mzscheme -> scheme

Browse Source 
svn: r16240
This commit is contained in:
Eli Barzilay 2009-10-05 04:36:22 +00:00
parent b0e8fac1f8
commit e499c32435
1 changed files with 66 additions and 70 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

34
collects/setup/winvers-change.ss
View File

@ -8,15 +8,15 @@
;; running MzScheme.exe on Windows -- "winvers.ss" uses a trick of making a ;; running MzScheme.exe on Windows -- "winvers.ss" uses a trick of making a
;; copy of the binary and restarting that copy for the actual change. ;; copy of the binary and restarting that copy for the actual change.
(module winvers-change mzscheme #lang scheme
(define verbose? #t) (define verbose? #t)
(define binary-extensions '("exe" "dll" "lib" "so" "def" "exp" #|"obj" "o"|#)) (define binary-extensions '("exe" "dll" "lib" "so" "def" "exp" #|"obj" "o"|#))
(define xxxs #"xxxxxxx") (define xxxs #"xxxxxxx")
(define xxxs-re (define xxxs-re
(bytes-append #"(?:lib(?:mzsch|mzgc|mred)(?:|3m))(" xxxs #")")) (bytes-append #"(?:lib(?:mzsch|mzgc|mred)(?:|3m))(" xxxs #")"))
(define renaming (regexp (format "^~a[.](?:dll|lib|exp)$" xxxs-re))) (define renaming (regexp (format "^~a[.](?:dll|lib|exp)$" xxxs-re)))
(define substitutions (define substitutions
(map (lambda (s) (byte-regexp (regexp-replace #rx#"~a" s xxxs-re))) (map (lambda (s) (byte-regexp (regexp-replace #rx#"~a" s xxxs-re)))
;; pdb not needed, but this way we can expect no ;; pdb not needed, but this way we can expect no
;; `xxxxxxx's when we finish. ;; `xxxxxxx's when we finish.
@ -26,15 +26,15 @@
#"__head_~a_lib\0" #"__head_~a_lib\0"
#"__~a_lib_iname\0"))) #"__~a_lib_iname\0")))
(require dynext/filename-version) (require dynext/filename-version)
(define version-bytes (string->bytes/utf-8 filename-version-part)) (define version-bytes (string->bytes/utf-8 filename-version-part))
(define (binary-file? filename) (define (binary-file? filename)
(cond [(regexp-match #rx"[.]([^.]+)$" filename) => (cond [(regexp-match #rx"[.]([^.]+)$" filename) =>
(lambda (m) (member (string-downcase (cadr m)) binary-extensions))] (lambda (m) (member (string-downcase (cadr m)) binary-extensions))]
[else #f])) [else #f]))
(define (do-file file) (define (do-file file)
(define (full-path) ; proc since `file' can change (define (full-path) ; proc since `file' can change
(build-path (current-directory) file)) (build-path (current-directory) file))
(let ([dfile (string-downcase file)]) (let ([dfile (string-downcase file)])
@ -51,7 +51,7 @@
"Warning: ~a was not renamed!\n" (full-path))])) "Warning: ~a was not renamed!\n" (full-path))]))
(let-values ([(i o) (open-input-output-file file 'update)]) (let-values ([(i o) (open-input-output-file file 'update)])
(define print? verbose?) (define print? verbose?)
(for-each (lambda (subst) (for ([subst (in-list substitutions)])
(file-position i 0) (file-position i 0)
(let loop ([pos 0]) (let loop ([pos 0])
(cond [(regexp-match-positions subst i) => (cond [(regexp-match-positions subst i) =>
@ -64,7 +64,6 @@
(flush-output o) (flush-output o)
(file-position i (+ pos (cdar m))) (file-position i (+ pos (cdar m)))
(loop (+ pos (cdar m))))]))) (loop (+ pos (cdar m))))])))
substitutions)
(file-position i 0) (file-position i 0)
(when (regexp-match-positions xxxs i) (when (regexp-match-positions xxxs i)
(fprintf (current-error-port) (fprintf (current-error-port)
@ -72,15 +71,12 @@
(close-input-port i) (close-input-port i)
(close-output-port o))) (close-output-port o)))
(let loop ([paths (if (zero? (vector-length (current-command-line-arguments))) (let loop ([paths (if (zero? (vector-length (current-command-line-arguments)))
'(".") '(".")
(vector->list (current-command-line-arguments)))]) (vector->list (current-command-line-arguments)))])
(for-each (lambda (path) (for ([path (in-list paths)])
(cond [(file-exists? path) (cond [(file-exists? path)
(when (binary-file? path) (do-file path))] (when (binary-file? path) (do-file path))]
[(directory-exists? path) [(directory-exists? path)
(parameterize ([current-directory path]) (parameterize ([current-directory path])
(loop (map path->string (directory-list))))])) (loop (map path->string (directory-list))))])))
paths))
)