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

Updating to use new props format

Browse Source
This commit is contained in:
Jay McCarthy 2010-05-14 11:04:58 -06:00
parent 05c8289925
commit 1d0bc61098
2 changed files with 27 additions and 32 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

25
collects/meta/drdr/metadata.ss
View File

@ -7,25 +7,26 @@
(define PROP:timeout "drdr:timeout") (define PROP:timeout "drdr:timeout")
(define (path-command-line a-path) (define (path-command-line a-path)
(match (get-prop a-path 'drdr:command-line #f)
[#f
(define suffix (filename-extension a-path)) (define suffix (filename-extension a-path))
(define default-cmd
(and suffix (and suffix
(cond (cond
[(ormap (lambda (bs) (bytes=? suffix bs)) [(ormap (lambda (bs) (bytes=? suffix bs))
(list #"ss" #"scm" #"scrbl" #"rkt" #"sls")) (list #"ss" #"scm" #"scrbl" #"rkt" #"sls"))
(list "racket" "-qt" (path->string* a-path))] '(racket "-qt" *)]
[(ormap (lambda (bs) (bytes=? suffix bs)) [(ormap (lambda (bs) (bytes=? suffix bs))
(list #"rktl")) (list #"rktl"))
(list "racket" "-f" (path->string* a-path))] '(racket "-f" *)]
[else [else
#f]))] #f])))
["" (define (replace-* s)
#f] (if (eq? '* s)
[(? string? s) (path->string* a-path)
(map (lambda (s) s))
(regexp-replace (regexp-quote "~s") s (path->string* a-path))) (match (get-prop a-path 'drdr:command-line default-cmd)
(regexp-split #rx" " s))])) [#f #f]
[(? list? l)
(map replace-* l)]))
(define (path-timeout a-path) (define (path-timeout a-path)
(get-prop a-path 'drdr:timeout #f)) (get-prop a-path 'drdr:timeout #f))
@ -42,7 +43,7 @@
[PROP:command-line string?] [PROP:command-line string?]
[PROP:timeout string?] [PROP:timeout string?]
[path-responsible (path-string? . -> . (or/c string? false/c))] [path-responsible (path-string? . -> . (or/c string? false/c))]
[path-command-line (path-string? . -> . (or/c (listof string?) false/c))] [path-command-line (path-string? . -> . (or/c (cons/c symbol? (listof string?)) false/c))]
[path-random? (path-string? . -> . boolean?)] [path-random? (path-string? . -> . boolean?)]
[path-timeout (path-string? . -> . (or/c exact-nonnegative-integer? false/c))]) [path-timeout (path-string? . -> . (or/c exact-nonnegative-integer? false/c))])

16
collects/meta/drdr/plt-build.ss
View File

@ -186,20 +186,14 @@
(match pth-cmd/general (match pth-cmd/general
[#f [#f
#f] #f]
[(list-rest "mzscheme" rst) [(list-rest (or 'mzscheme 'racket) rst)
(lambda () (list* racket-path rst))] (lambda () (list* racket-path rst))]
[(list-rest "racket" rst) [(list-rest 'mzc rst)
(lambda () (list* racket-path rst))]
[(list-rest "mzc" rst)
(lambda () (list* mzc-path rst))] (lambda () (list* mzc-path rst))]
[(list-rest "mred-text" rst) [(list-rest (or 'mred 'mred-text
'gracket 'gracket-text)
rst)
(lambda () (list* gracket-text-path "-display" (format ":~a" (+ XSERVER-OFFSET (current-worker))) rst))] (lambda () (list* gracket-text-path "-display" (format ":~a" (+ XSERVER-OFFSET (current-worker))) rst))]
[(list-rest "mred" rst)
(lambda () (list* gracket-path "-display" (format ":~a" (+ XSERVER-OFFSET (current-worker))) rst))]
[(list-rest "gracket-text" rst)
(lambda () (list* gracket-text-path "-display" (format ":~a" (+ XSERVER-OFFSET (current-worker))) rst))]
[(list-rest "gracket" rst)
(lambda () (list* gracket-path "-display" (format ":~a" (+ XSERVER-OFFSET (current-worker))) rst))]
[_ [_
#f]))] #f]))]
(if pth-cmd (if pth-cmd