Permalink
Browse files

Replaced generate to console with generate to frame

  • Loading branch information...
1 parent f5f93c3 commit 0a496d445e22c07311b3251330b142926d1ad727 @Metaxal committed Aug 7, 2012
Showing with 29 additions and 3 deletions.
  1. +28 −2 controller.ss
  2. +1 −1 toolbox-frame.ss
View
@@ -367,10 +367,36 @@
; (path->string file))
)))
+;; Like frame:text% but without exiting the app when closing the window
+(define no-exit-frame:text%
+ (class frame:text%
+ (super-new)
+ (define/override (on-exit)
+ ;(printf "on-exit\n")
+ (void))
+ (define/override (can-exit?)
+ ;(printf "can-exit?\n")
+ #f)
+ (define/augment (on-close)
+ ;(printf "on-close\n")
+ (void))
+ (define/augment (can-close?)
+ ;(printf "can-close?\n")
+ (send this show #f)
+ #f)
+ ))
+
(define/provide (controller-generate-code-to-console [mid (get-current-mred-id)])
(when mid
- (let ([project-mid (send mid get-top-mred-parent)])
- (generate-module project-mid))))
+ (define project-mid (send mid get-top-mred-parent))
+ (define f (new no-exit-frame:text%
+ [min-height 500]))
+ (send f set-label (->string (send project-mid get-id)))
+ (define txt (send f get-editor))
+ (send txt insert
+ (with-output-to-string (λ _ (generate-module project-mid))))
+ (send f show #t)
+ ))
(define/provide (controller-generate-code [mid (get-current-mred-id)]
#:ask [ask-user? #t])
View
@@ -215,7 +215,7 @@
)]
)
(new button%
- [label "To console"]
+ [label "To frame"]
[parent hp]
[min-width 110]
[callback (λ _ (generate-code-to-console-callback))])

0 comments on commit 0a496d4

Please sign in to comment.