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

PR 10273

Browse Source 
svn: r15023
This commit is contained in:
Robby Findler 2009-05-30 13:04:03 +00:00
parent 82e256473d
commit dad81d2010
1 changed files with 45 additions and 30 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

75
collects/drscheme/private/tools.ss
View File

@ -82,36 +82,51 @@
;; installed-tools-for-directory : directory-record -> (list-of installed-tool) ;; installed-tools-for-directory : directory-record -> (list-of installed-tool)
(define (installed-tools-for-directory coll-dir) (define (installed-tools-for-directory coll-dir)
(let ([table (get-info/full (directory-record-path coll-dir))]) (let ([table (with-handlers ((exn:fail? values))
(if table (get-info/full (directory-record-path coll-dir)))])
(let* ([tools (table 'tools (lambda () null))] (cond
[tool-icons (table 'tool-icons (lambda () (map (lambda (x) #f) tools)))] [(not table)
[tool-names (table 'tool-names (lambda () (map (lambda (x) #f) tools)))] null]
[tool-urls (table 'tool-urls (lambda () (map (lambda (x) #f) tools)))]) [(exn? table)
(unless (= (length tools) (length tool-icons)) (message-box (string-constant drscheme)
(message-box (string-constant drscheme) (format (string-constant error-loading-tool-title)
(format (string-constant tool-tool-icons-same-length) (directory-record-path coll-dir)
coll-dir tools tool-icons) (let ([sp (open-output-string)])
#f (parameterize ([current-error-port sp]
'(ok stop)) [current-error-port sp])
(set! tool-icons (map (lambda (x) #f) tools))) (drscheme:init:original-error-display-handler (exn-message table) table))
(unless (= (length tools) (length tool-names)) (get-output-string sp)))
(message-box (string-constant drscheme) #f
(format (string-constant tool-tool-names-same-length) '(ok stop))
coll-dir tools tool-names) null]
#f [else
'(ok stop)) (let* ([tools (table 'tools (lambda () null))]
(set! tool-names (map (lambda (x) #f) tools))) [tool-icons (table 'tool-icons (lambda () (map (lambda (x) #f) tools)))]
(unless (= (length tools) (length tool-urls)) [tool-names (table 'tool-names (lambda () (map (lambda (x) #f) tools)))]
(message-box (string-constant drscheme) [tool-urls (table 'tool-urls (lambda () (map (lambda (x) #f) tools)))])
(format (string-constant tool-tool-urls-same-length) (unless (= (length tools) (length tool-icons))
coll-dir tools tool-urls) (message-box (string-constant drscheme)
#f (format (string-constant tool-tool-icons-same-length)
'(ok stop)) coll-dir tools tool-icons)
(set! tool-urls (map (lambda (x) #f) tools))) #f
(map (lambda (t i n u) (make-installed-tool coll-dir t i n u)) '(ok stop))
tools tool-icons tool-names tool-urls)) (set! tool-icons (map (lambda (x) #f) tools)))
null))) (unless (= (length tools) (length tool-names))
(message-box (string-constant drscheme)
(format (string-constant tool-tool-names-same-length)
coll-dir tools tool-names)
#f
'(ok stop))
(set! tool-names (map (lambda (x) #f) tools)))
(unless (= (length tools) (length tool-urls))
(message-box (string-constant drscheme)
(format (string-constant tool-tool-urls-same-length)
coll-dir tools tool-urls)
#f
'(ok stop))
(set! tool-urls (map (lambda (x) #f) tools)))
(map (lambda (t i n u) (make-installed-tool coll-dir t i n u))
tools tool-icons tool-names tool-urls))])))
;; candidate-tool? : installed-tool -> boolean ;; candidate-tool? : installed-tool -> boolean
;; Predicate for tools selected for execution in this ;; Predicate for tools selected for execution in this