#lang scheme
(require (lib "tool.ss" "drscheme")
        mred
        mzlib/unit
        scheme/class
        scheme/system
        "packer.ss")
(provide tool@)
(define tool@
  (unit
    (import drscheme:tool^)
    (export drscheme:tool-exports^)
    (define phase1 void)
    (define phase2 void) 
    
    (define vc-frame-mixin
      (mixin (drscheme:unit:frame<%>) () 
        
        (define (packit menu-item control-event)
          (let* ((file (get-current-tab-filename)))
            (if file (make-planet-archive (create-planet-info file))
             void)))
        
        (define/override (file-menu:between-save-as-and-print file-menu)
          ; (make-object separator-menu-item% file-menu)
          (new menu-item%  
              [label "Pack .plt"]
              [parent file-menu]
              [callback packit])
          )
        
        ; (text% : class?) -> (or/c path-string? false/c)
        (define (file-path editor)
          (send editor get-filename))
        
        (define (this-tab predicate? action)
          (let* ([tab (send this get-current-tab)]
                 [editor (send tab get-defs)])
            (when (predicate? editor) (action editor))))
        
        ;; get-current-tab-filename -> (or/c path-string? false/c)
        ;; return #f if tab has no filename
        (define (get-current-tab-filename)
          (send (send (send this get-current-tab) get-defs) get-filename))
        
        (super-new)))
    
    (drscheme:get/extend:extend-unit-frame vc-frame-mixin)))