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

adjust to better layout of launchers -- possible to rewrite an already-absolute launcher

Browse Source 
svn: r3438
This commit is contained in:
Eli Barzilay 2006-06-22 18:42:38 +00:00
parent 35d662e582
commit 740e8e4702
1 changed files with 6 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

17
collects/setup/unixstyle-install.ss
View File

@ -108,18 +108,12 @@
(mv src dst) (mv src dst)
(set! path-changes (cons (cons src dst) path-changes))) (set! path-changes (cons (cons src dst) path-changes)))
(define binary-re
#rx#"coLLECTs dIRECTORy:")
(define script-re
(byte-regexp (bytes-append #"\n# Make this PATH-independent\n.*?"
#"\nbindir=\"[$]D\"\nPATH=\"[$]saveP\"\n")))
(define (bin-mover src dst) (define (bin-mover src dst)
(define (binary-move) (define (binary-move)
;; don't move => modify a copy of the running mzscheme ;; don't move => modify a copy of the running mzscheme
(copy-file src dst) (delete-file src) (copy-file src dst) (delete-file src)
(let-values ([(i o) (open-input-output-file dst 'update)]) (let-values ([(i o) (open-input-output-file dst 'update)])
(let ([m (regexp-match-positions binary-re i)]) (let ([m (regexp-match-positions #rx#"coLLECTs dIRECTORy:" i)])
(unless m (unless m
(error (error
(format "could not find collection-path label in executable: ~a" (format "could not find collection-path label in executable: ~a"
@ -133,15 +127,16 @@
(define (script-move) (define (script-move)
(let* ([size (file-size src)] (let* ([size (file-size src)]
[buf (with-input-from-file src (lambda () (read-bytes size)))] [buf (with-input-from-file src (lambda () (read-bytes size)))]
[m (or (regexp-match-positions script-re buf) [m (or (regexp-match-positions
#rx#"\n# {{{ bindir\n(.*?\n)# }}} bindir\n" buf)
(error (format "could not find binpath block in script: ~a" (error (format "could not find binpath block in script: ~a"
src)))]) src)))])
(with-output-to-file dst (with-output-to-file dst
(lambda () (lambda ()
(write-bytes buf (current-output-port) 0 (caar m)) (write-bytes buf (current-output-port) 0 (caadr m))
(printf "\nbindir=\"~a\"\n" (printf "bindir=\"~a\"\n"
(regexp-replace* #rx"[\"`'$\\]" (->string bindir) "\\\\&")) (regexp-replace* #rx"[\"`'$\\]" (->string bindir) "\\\\&"))
(write-bytes buf (current-output-port) (cdar m))) (write-bytes buf (current-output-port) (cdadr m)))
'truncate/replace) 'truncate/replace)
(delete-file src))) (delete-file src)))
(let ([magic (with-input-from-file src (lambda () (read-bytes 10)))]) (let ([magic (with-input-from-file src (lambda () (read-bytes 10)))])