From a32e1ac4c17d6fac8434cf6ab920d59f34ffcea1 Mon Sep 17 00:00:00 2001 From: Robby Findler Date: Mon, 14 Apr 2014 16:49:40 -0500 Subject: [PATCH] point to the contract profiler original commit: 7b26260d998f24fa330447660fa68609eef553ac --- pkgs/gui-pkgs/gui-lib/mrlib/private/dot.rkt | 31 +++++++++++++-------- 1 file changed, 20 insertions(+), 11 deletions(-) diff --git a/pkgs/gui-pkgs/gui-lib/mrlib/private/dot.rkt b/pkgs/gui-pkgs/gui-lib/mrlib/private/dot.rkt index 322aef1d..8f8a1060 100644 --- a/pkgs/gui-pkgs/gui-lib/mrlib/private/dot.rkt +++ b/pkgs/gui-pkgs/gui-lib/mrlib/private/dot.rkt @@ -11,6 +11,12 @@ (define neato-hier-label "neato – hier") (define neato-ipsep-label "neato – ipsep") +;; the code that finds the dot executable is the same as +;; pkg/contract-profile/dot.rkt; please check the other +;; place if you find a bug here. the only reason it isn't +;; shared is dependencies and lack of an obvious common +;; place in between to put it. + ;; these paths are explicitly checked (when find-executable-path ;; fails) because starting drracket from the finder (or the dock) ;; under mac os x generally does not get the path right. @@ -24,17 +30,20 @@ (define neato.exe (if (eq? (system-type) 'windows) "neato.exe" "neato")) (define (find-dot [neato? #f]) - (cond - [(and (find-executable-path dot.exe) - (find-executable-path neato.exe)) - (if neato? - (find-executable-path neato.exe) - (find-executable-path dot.exe))] - [else - (ormap (λ (x) (and (file-exists? (build-path x dot.exe)) - (file-exists? (build-path x neato.exe)) - (build-path x (if neato? neato.exe dot.exe)))) - dot-paths)])) + (with-handlers ([(lambda (e) ; may not have permission + (and (exn:fail? e) + (regexp-match "access denied" (exn-message e)))) + (λ (x) #f)]) + (define dp (find-executable-path dot.exe)) + (define np (find-executable-path neato.exe)) + (cond + [(and dp np) + (if neato? np dp)] + [else + (ormap (λ (x) (and (file-exists? (build-path x dot.exe)) + (file-exists? (build-path x neato.exe)) + (build-path x (if neato? neato.exe dot.exe)))) + dot-paths)]))) (define (dot-positioning pb [option dot-label] [overlap? #f]) (define dot-path (find-dot (regexp-match #rx"neato" option)))