#lang scheme/base
(require drscheme/tool
         mred
         mrlib/switchable-button
         mrlib/path-dialog
         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 this-tab-dir x)
      (let* ((chooser (new path-dialog% 
                           [directory this-tab-dir];home-dir]
                           [put? #t] 
                           [filename "saved-tabs-file.ss"]
                           [label "Save current tabs to.."]
                           [message "Save a tabs file"]
                           [filters (list (list "Scheme Project Files" "*.scm;*.ss"))]
                           ))
             (out-file (send chooser run))
             )
        (when out-file
          (call-with-output-file out-file; saved-tabs-file-path
            (lambda (i) (write x i))
            #:exists 'replace
            ))))
    
    (define (load current-tab-files-pathstrings home-dir)
      (let* ((chooser (new path-dialog% 	
                           [directory home-dir]
                           [label "Load Tabs file"]
                           [message "Choose a tabs file to load"]
                           [filename "saved-tabs-file.ss"]
                           [existing? #t] 
                           [filters (list '("Scheme Project Files" "saved-tabs-file.ss")
                                          '("Scheme Files" "*.scm;*.ss")
                                          )]
                           ))
             (in-file (send chooser run))
             )
        (when in-file
          (for-each (lambda (filename) (drscheme:unit:open-drscheme-window filename))
                    (remove* current-tab-files-pathstrings
                             (if (file-exists?  saved-tabs-file-path)
                                 (call-with-input-file in-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 path->string
               (filter (lambda (filename) filename)
                       
                       (map (lambda (tab) (file-path (send tab get-defs)))
                            (send this get-tabs))
                       ))
          )
        
        ; (text% : class?) -> (or/c path-string? false/c)
        (define (file-path editor)
          (send editor get-filename))
        
        (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) (let* ((this-tab (send this get-current-tab))
                                                 (this-tab-dir (send this-tab get-directory)))
                                            (save this-tab-dir (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) (let* ((this-tab (send this get-current-tab))
                                                 (this-tab-dir (send this-tab get-directory)))
                                            (if this-tab-dir (load (get-tab-files) this-tab-dir) (load (get-tab-files) home-dir)
                                                ))))
               [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)
    ))