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

drracket tools manager: indicated skipped and failed tools

Browse Source 
Closes PR 10952
This commit is contained in:
Ryan Culpepper 2010-06-02 14:41:00 -06:00
parent add2cbbbda
commit 4e54ae0c02
1 changed files with 44 additions and 37 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

45
collects/drracket/private/tools.rkt
View File

@ -40,17 +40,8 @@ string-constants)
;; installed-tools : (list-of installed-tool) ;; installed-tools : (list-of installed-tool)
(define installed-tools null) (define installed-tools null)
;; successful-tool = (make-successful-tool module-spec ;; candidate-tools : (listof installed-tool)
;; (union #f (instanceof bitmap%)) (define candidate-tools null)
;; (union #f string)
;; (union #f string))
(define-struct successful-tool (spec bitmap name url))
;; successful-tools : (listof successful-tool)
(define successful-tools null)
;; get-successful-tools : -> (listof successful-tool)
(define (get-successful-tools) successful-tools)
;; successfully-loaded-tool = ;; successfully-loaded-tool =
;; (make-successfully-loaded-tool ;; (make-successfully-loaded-tool
@ -63,13 +54,25 @@ string-constants)
;; it is updated in load/invoke-tool. ;; it is updated in load/invoke-tool.
(define successfully-loaded-tools null) (define successfully-loaded-tools null)
;; successful-tool = (make-successful-tool module-spec
;; (union #f (instanceof bitmap%))
;; (union #f string)
;; (union #f string))
(define-struct successful-tool (spec bitmap name url))
;; successful-tools : (listof successful-tool)
(define successful-tools null)
;; get-successful-tools : -> (listof successful-tool)
(define (get-successful-tools) successful-tools)
;; load/invoke-all-tools : -> void ;; load/invoke-all-tools : -> void
(define (load/invoke-all-tools phase1-extras phase2-extras) (define (load/invoke-all-tools phase1-extras phase2-extras)
(rescan-installed-tools!) (rescan-installed-tools!)
(set! current-phase 'loading-tools) (set! current-phase 'loading-tools)
(let ([candidate-tools (filter candidate-tool? installed-tools)]) (set! candidate-tools (filter candidate-tool? installed-tools))
(for-each load/invoke-tool candidate-tools) (for-each load/invoke-tool candidate-tools)
(run-phases phase1-extras phase2-extras))) (run-phases phase1-extras phase2-extras))
;; rescan-installed-tools! : -> void ;; rescan-installed-tools! : -> void
(define (rescan-installed-tools!) (define (rescan-installed-tools!)
@ -83,7 +86,8 @@ string-constants)
;; all-tool-directories : -> (list-of directory-record) ;; all-tool-directories : -> (list-of directory-record)
(define (all-tool-directories) (define (all-tool-directories)
(find-relevant-directory-records '(drracket-tools drracket-tool-icons drracket-tool-names drracket-tool-urls (find-relevant-directory-records
'(drracket-tools drracket-tool-icons drracket-tool-names drracket-tool-urls
tools tool-icons tool-names tool-urls))) tools tool-icons tool-names tool-urls)))
;; installed-tools-for-directory : directory-record -> (list-of installed-tool) ;; installed-tools-for-directory : directory-record -> (list-of installed-tool)
@ -147,8 +151,8 @@ string-constants)
[(getenv "PLTNOTOOLS") [(getenv "PLTNOTOOLS")
(printf "PLTNOTOOLS: skipping tools\n") (flush-output) (printf "PLTNOTOOLS: skipping tools\n") (flush-output)
(lambda (it) #f)] (lambda (it) #f)]
[(getenv "PLTONLYTOOL") => [(getenv "PLTONLYTOOL")
(lambda (onlys) => (lambda (onlys)
(let* ([allowed (let ([exp (read (open-input-string onlys))]) (let* ([allowed (let ([exp (read (open-input-string onlys))])
(cond (cond
[(symbol? exp) (list exp)] [(symbol? exp) (list exp)]
@ -558,9 +562,12 @@ string-constants)
(let ([name (or (installed-tool-name it) (let ([name (or (installed-tool-name it)
(format "unnamed tool ~a" (format "unnamed tool ~a"
(installed-tool->module-spec it)))]) (installed-tool->module-spec it)))])
(if (installed-tool-is-loaded? it) (cond [(installed-tool-is-loaded? it)
(string-append name " (loaded)") (string-append name " (loaded)")]
name))) [(not (memq it candidate-tools))
(string-append name " (skipped)")]
[else
(string-append name " (failed to load)")])))
(define (on-select-tool) (define (on-select-tool)
(let ([it (get-selected-tool)]) (let ([it (get-selected-tool)])
(send* location-editor (send* location-editor