(module config-panel mzscheme
(require (lib "class.ss")
(lib "mred.ss" "mred")
"acl2-settings.ss"
"acl2-location-pref.ss"
"admit-before-run-pref.ss"
"find-acl2.ss"
)
(provide attach-config-panel!)
(define (attach-config-panel! parent super-param)
(let ([vp (new group-box-panel%
[parent parent]
[label "ACL2 Options"]
[alignment '(left center)])])
(let* ([admit-before-run-cb
(new check-box%
[label "Admit Definitions Before Run"]
[parent vp]
[value (get-admit-before-run?)]
[callback
(lambda (this e)
(set-admit-before-run? (send this get-value)))])]
[acl2-location-text
(new text-field%
[label "ACL2 Location"]
[parent vp]
[enabled #f] [min-width 400]
[init-value (path->string (get-acl2-location))])]
[hp (new horizontal-pane%
[parent vp]
[alignment '(center center)])]
[find-acl2-button
(new button%
[label "Change ACL2 Location"]
[parent hp]
[callback
(lambda (b e)
(cond [(find-acl2 #f)
=> (lambda (new-path)
(send acl2-location-text
set-value (path->string new-path)))]
[else (void)]))])])
(send (car (send parent get-children))
change-children
(lambda (children)
(let ([input-options (car children)]
[output-options (caddr children)])
(remq input-options (remq output-options children)))))
(case-lambda
[()
(cons (make-acl2-settings (send acl2-location-text get-value)
(send admit-before-run-cb get-value))
(super-param))]
[(settings)
(super-param (cdr settings))
(let ([a (car settings)])
(send admit-before-run-cb set-value
(acl2-settings-admit-before-run? a))
(send acl2-location-text set-value
(acl2-settings-acl2-loc a)))]))))
)