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

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

@ -82,8 +82,24 @@
;; 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)))])
(cond
[(not table)
null]
[(exn? table)
(message-box (string-constant drscheme)
(format (string-constant error-loading-tool-title)
(directory-record-path coll-dir)
(let ([sp (open-output-string)])
(parameterize ([current-error-port sp]
[current-error-port sp])
(drscheme:init:original-error-display-handler (exn-message table) table))
(get-output-string sp)))
#f
'(ok stop))
null]
[else
(let* ([tools (table 'tools (lambda () null))] (let* ([tools (table 'tools (lambda () null))]
[tool-icons (table 'tool-icons (lambda () (map (lambda (x) #f) tools)))] [tool-icons (table 'tool-icons (lambda () (map (lambda (x) #f) tools)))]
[tool-names (table 'tool-names (lambda () (map (lambda (x) #f) tools)))] [tool-names (table 'tool-names (lambda () (map (lambda (x) #f) tools)))]
@ -110,8 +126,7 @@
'(ok stop)) '(ok stop))
(set! tool-urls (map (lambda (x) #f) tools))) (set! tool-urls (map (lambda (x) #f) tools)))
(map (lambda (t i n u) (make-installed-tool coll-dir t i n u)) (map (lambda (t i n u) (make-installed-tool coll-dir t i n u))
tools tool-icons tool-names tool-urls)) tools tool-icons tool-names tool-urls))])))
null)))
;; 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