project.scm
#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)
        
        ;; each-tab -> list of files
        (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)
    ))