#lang scheme/gui
(require drscheme/tool
framework
"dracula-interfaces.ss"
"executable-path.ss")
(provide dracula-drscheme-frame^
dracula-drscheme-frame@)
(define-signature dracula-drscheme-frame^
(dracula-drscheme-frame-mixin))
(define-unit dracula-drscheme-frame@
(import drscheme:tool^ dracula-interfaces^)
(export dracula-drscheme-frame^)
(define dracula-drscheme-frame-mixin
(mixin (drscheme:unit:frame<%>) (dracula-drscheme-frame<%>)
(inherit get-current-tab)
(define/override (get-definitions/interactions-panel-parent)
(let* ([top (super get-definitions/interactions-panel-parent)]
[mid (new panel:horizontal-dragable% [parent top])]
[bot (new vertical-panel% [parent mid])])
(set! dracula-gui-container mid)
(queue-callback
(lambda ()
(send (get-current-tab) update-dracula-gui))
#f)
bot))
(define/augment (on-tab-change old-tab new-tab)
(queue-callback
(lambda ()
(send new-tab update-dracula-gui))
#f)
(inner (void) on-tab-change old-tab new-tab))
(define/public (get-dracula-gui-container)
(unless (is-a? dracula-gui-container area-container<%>)
(error 'Dracula
"~a\n~a: expected an area container, got: ~e"
"internal error: GUI failed to initialize."
'get-dracula-gui-container
dracula-gui-container))
dracula-gui-container)
(define/public (get-dracula-menu-items)
(unless (is-a? language-menu labelled-menu-item<%>)
(error 'Dracula
"~a\n~a: expected a labelled menu item, got: ~e"
"internal error: GUI failed to initialize."
'get-dracula-menu-items
language-menu))
(list acl2-show/hide-menu-item
acl2-save-menu-item
acl2-path-menu-item))
(define/public (dracula-proof-shown shown?)
(unless (is-a? language-menu labelled-menu-item<%>)
(error 'Dracula
"~a\n~a: expected a labelled menu item, got: ~e"
"internal error: GUI failed to initialize."
'dracula-proof-shown
acl2-show/hide-menu-item))
(send acl2-show/hide-menu-item set-label
(if shown? "Hide ACL2 Window" "Show ACL2 Window")))
(define dracula-gui-container #f)
(super-new)
(inherit get-language-menu)
(define language-menu (get-language-menu))
(new separator-menu-item% [parent language-menu])
(define acl2-show/hide-menu-item
(new menu-item%
[parent language-menu]
[label "Show/Hide ACL2 Window"]
[callback (lambda _ (send (get-current-tab) toggle-show-proof))]))
(define acl2-save-menu-item
(new menu-item%
[parent language-menu]
[label "Save ACL2 Output As..."]
[callback (lambda _ (send (get-current-tab) save-output))]))
(define acl2-path-menu-item
(new menu-item%
[label "Change ACL2 Executable Path..."]
[parent language-menu]
[callback (lambda _ (prompt-and-set-executable-path))]))
)))