62 lines
1.6 KiB
Scheme
62 lines
1.6 KiB
Scheme
|
|
(module macfw mzscheme
|
|
(require (lib "process.ss"))
|
|
|
|
(provide update-framework-path
|
|
get-current-framework-path
|
|
update-framework-path/cmdline)
|
|
|
|
(define (update-framework-path/cmdline)
|
|
(let ([v (current-command-line-arguments)])
|
|
(update-framework-path (vector-ref v 0)
|
|
(vector-ref v 1)
|
|
(equal? (vector-ref v 2) "mred"))))
|
|
|
|
(define (update-framework-path fw-path dest mred?)
|
|
(let ([dest (if (path? dest)
|
|
(path->string dest)
|
|
dest)])
|
|
(for-each (lambda (p)
|
|
(let* ([orig (get-current-framework-path dest p)]
|
|
[3m (if (and orig (regexp-match #rx"_3m" orig))
|
|
"_3m"
|
|
"")])
|
|
(system* "/usr/bin/install_name_tool"
|
|
"-change"
|
|
(or orig
|
|
(format "~a.framework/Versions/~a~a/~a" p (version) 3m p))
|
|
(format "~a~a.framework/Versions/~a~a/~a"
|
|
fw-path
|
|
p (version) 3m p)
|
|
dest)))
|
|
(if mred?
|
|
'("PLT_MrEd")
|
|
'("PLT_MzScheme")))))
|
|
|
|
(define (get-current-framework-path dest p)
|
|
(let-values ([(r w) (make-pipe)])
|
|
(parameterize ([current-output-port w])
|
|
(system* "/usr/bin/otool"
|
|
"-L"
|
|
(if (path? dest)
|
|
(path->string dest)
|
|
dest)))
|
|
(close-output-port w)
|
|
(let ([m (regexp-match (bytes-append #"[\r\n][ \t]*([^ \t][^\r\n]*"
|
|
(string->bytes/utf-8 p)
|
|
#"[^\r\n]*)"
|
|
#" [(]compatibility version [0-9.]*,"
|
|
#" current version [0-9.]*[)][\r\n]")
|
|
r)])
|
|
(if m
|
|
(bytes->string/utf-8 (cadr m))
|
|
(begin
|
|
(fprintf (current-error-port)
|
|
"warning: cannot find existing link for ~a in ~a\n"
|
|
p dest)
|
|
#f))))))
|
|
|
|
|
|
|
|
|
|
|