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

PR 10115

Browse Source 
svn: r13969
This commit is contained in:
Robby Findler 2009-03-05 13:29:25 +00:00
parent ac70e716f8
commit c063b4305c
1 changed files with 16 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

22
collects/redex/private/dot.ss
View File

@ -1,7 +1,7 @@
#lang scheme/gui #lang scheme/gui
(provide/contract [dot-positioning (-> (is-a?/c pasteboard%) string? boolean? void?)] (provide/contract [dot-positioning (-> (is-a?/c pasteboard%) string? boolean? void?)]
[find-dot (-> (or/c string? false/c))]) [find-dot (-> (or/c path? false/c))])
(require scheme/system) (require scheme/system)
@ -11,6 +11,9 @@
(define neato-hier-label "neato – hier") (define neato-hier-label "neato – hier")
(define neato-ipsep-label "neato – ipsep") (define neato-ipsep-label "neato – ipsep")
;; these paths are explicitly checked (when find-executable-path
;; fails) because starting drscheme from the finder (or the doc)
;; under mac os x generally does not get the path right.
(define dot-paths (define dot-paths
'("/usr/bin" '("/usr/bin"
"/bin" "/bin"
@ -18,10 +21,17 @@
"/opt/local/bin/")) "/opt/local/bin/"))
(define (find-dot [neato? #f]) (define (find-dot [neato? #f])
(ormap (λ (x) (and (file-exists? (build-path x "dot")) (cond
(file-exists? (build-path x "neato")) [(and (find-executable-path "dot")
(path->string (build-path x (if neato? "neato" "dot"))))) (find-executable-path "neato"))
dot-paths)) (if neato?
(find-executable-path "neato")
(find-executable-path "dot"))]
[else
(ormap (λ (x) (and (file-exists? (build-path x "dot"))
(file-exists? (build-path x "neato"))
(build-path x (if neato? "neato" "dot"))))
dot-paths)]))
(define (dot-positioning pb option overlap?) (define (dot-positioning pb option overlap?)
(let ([info (snip-info pb)]) (let ([info (snip-info pb)])
@ -92,7 +102,7 @@
(λ () (λ ()
(parameterize ([current-input-port in1] (parameterize ([current-input-port in1]
[current-output-port out2]) [current-output-port out2])
(system (format "~a -Tplain" (find-dot (regexp-match #rx"neato" option))))) (system (format "~a -Tplain" (path->string (find-dot (regexp-match #rx"neato" option))))))
(close-output-port out2) (close-output-port out2)
(close-input-port in1))) (close-input-port in1)))
(parse-plain in2))) (parse-plain in2)))