#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))
(path-file (create-planet-info file)))
(apply make-planet-archive path-file)))
(define/override (file-menu:between-save-as-and-print file-menu)
(new menu-item%
[label "Pack .plt"]
[parent file-menu]
[callback packit])
)
(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))))
(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)))