racket/collects/drracket/private/module-interface/gui.rkt

53 lines
2.0 KiB
Racket

#lang racket/base
;; Shows a gui of provided identifiers with some extra information such as
;; contracts (works)
;; typed racket types (doesn't work)
(require (prefix-in check: "check.rkt")
framework/framework
racket/gui/base
racket/class)
(provide build-gui)
(define (build-gui gui-parent file)
(define exports (check:get-exports file #true))
(for ([provide (map check:provided-syntaxes exports)])
(printf "syntaxes exports (~a): ~a\n" (length provide) (map check:print provide)))
(for ([provide (map check:provided-variables exports)])
(printf "variables (~a): ~a\n" (length provide) (map check:print provide)))
#;
(printf "exports: ~a\n" (map check:print
(map check:provided-syntaxes
(check:get-exports "x.rkt" #true))))
(define stuff (new vertical-pane% [parent gui-parent]))
(new message% [parent stuff] [label "Contracts"])
(define contract-pane (new horizontal-panel% [parent stuff]))
(define contract-text (new scheme:text%))
(define contract-editor (new editor-canvas% [parent contract-pane] [editor contract-text]))
(new message% [parent stuff] [label "No contracts"])
(define non-contract-pane (new horizontal-panel% [parent stuff]))
(define non-contract-text (new scheme:text%))
(define non-contract-editor (new editor-canvas% [parent non-contract-pane] [editor non-contract-text]))
(for ([provide/phase (map check:provided-syntaxes exports)])
(for ([symbol provide/phase])
(send contract-text insert (check:print symbol))
(send contract-text insert "\n")
))
(for ([provide/phase (map check:provided-variables exports)])
(for ([symbol provide/phase])
(send non-contract-text insert (check:print symbol))
(send non-contract-text insert "\n")
))
)
#|
(let ([frame (new frame:basic% [label ""] [width 500] [height 500])])
(build-gui (send frame get-area-container))
(send frame show #true))
|#