#lang scheme/base
(require (lib "tool.ss" "drscheme")
mred
mrlib/switchable-button
mzlib/unit
scheme/class)
(provide tool@)
(define tool@
(unit
(import drscheme:tool^)
(export drscheme:tool-exports^)
(define phase1 void)
(define phase2 void)
(define (save x file)
(call-with-output-file file
(lambda (i) (write x i))
#:exists 'replace
))
(define (load)
(for-each (lambda (filename)
(drscheme:unit:open-drscheme-window filename))
(if (file-exists? "project-save.psp")
(call-with-input-file "project-save.psp" (lambda (i) (read i)))
'()
)))
(define (projects-unit-frame-mixin super%)
(class super%
(inherit get-button-panel)
(define (get-tab-files)
(map
(lambda (tab)
(let ([editor (send tab get-defs)])
(when (file-exists? (send editor get-filename)) (path->string (send editor get-filename)))))
(send this get-tabs)))
(super-new)
(inherit register-toolbar-button)
(define save-project-button
(new switchable-button%
(label "save-project")
(parent (make-object vertical-pane% (get-button-panel)))
(callback (lambda (button) (save (get-tab-files) "project-save.psp")))
[bitmap (make-object bitmap% "project-icon.png")]
))
(register-toolbar-button save-project-button)
(send (get-button-panel) change-children
(lambda (_)
(cons (send save-project-button get-parent)
(remq (send save-project-button get-parent) _))))
(define load-project-button
(new switchable-button%
(label "load-project")
(parent (make-object vertical-pane% (get-button-panel)))
(callback (lambda (button) (load))) [bitmap (make-object bitmap% "project-icon.png")]
))
(register-toolbar-button load-project-button)
(send (get-button-panel) change-children
(lambda (_)
(cons (send load-project-button get-parent)
(remq (send load-project-button get-parent) _))))
))
(drscheme:get/extend:extend-unit-frame projects-unit-frame-mixin)
))