#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 project-icon "project.png")
(define project-icon-sm "project-sm.png")
(define home-dir (find-system-path 'home-dir))
(define saved-tabs-file (string->path "saved-tabs-file.ss"))
(define saved-tabs-file-path (build-path home-dir saved-tabs-file))
(define (save x)
(call-with-output-file saved-tabs-file-path
(lambda (i) (write x i))
#:exists 'replace
))
(define (load)
(for-each (lambda (filename)
(drscheme:unit:open-drscheme-window filename))
(if (file-exists? saved-tabs-file-path)
(call-with-input-file saved-tabs-file-path (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 project-icon-bitmap (make-object bitmap% project-icon-sm 'png/mask))
(define save-project-button
(new switchable-button%
(label "Save Tabs")
(parent (make-object vertical-pane% (get-button-panel)))
(callback (lambda (button) (save (get-tab-files))))
[bitmap project-icon-bitmap]
))
(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 "Reload Tabs")
(parent (make-object vertical-pane% (get-button-panel)))
(callback (lambda (button) (load)))
[bitmap project-icon-bitmap]
))
(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)
))