#lang racket/base

(require racket/gui/base

;; This tool adds a "Create Javascript Package" button to the Racket menu.

(provide tool@)

;; make-reasonable-package-name: path -> string
;; Tries to pick a reasonable default for the zip file name.
(define (make-reasonable-package-name a-path)
  (let-values ([(base name dir?)
                (split-path a-path)])
    (string-append (remove-filename-extension name)

;; make-package-subdirectory-name: path -> path
(define (make-package-subdirectory-name a-path)
  (let-values ([(base name dir?)
                (split-path a-path)])
    (remove-filename-extension name)))

(define tool@
    (import drracket:tool^)
    (export drracket:tool-exports^)
    ;; We're not doing anything language specific, so I don't think we need
    ;; to plug into phase1 or phase2.
    (define (phase1) (void))
    (define (phase2) (void))

    ;; unit-frame<%>: interface
    ;; Just a helper interface used for the mixin below.
    (define unit-frame<%> (class->interface drracket:unit:frame%))

    ;; Here we mix in a menu item into the unit frame's Racket menu.
     (mixin (unit-frame<%>) (unit-frame<%>)
       (inherit get-language-menu
       ;; click!: menu-item% control-event% -> void
       ;; On selection, prompts for a output zip file name, and then writes a zip
       ;; with the contents.
       (define (click! a-menu-item a-control-event)
         (let* ([a-text (get-definitions-text)]
                [a-filename (send a-text get-filename)])
             [(not (path-string? a-filename))
              (message-box "Create Javascript Package"
                           "Your program needs to be saved first before packaging.")]
             [(send a-text is-modified?)
              (message-box "Create Javascript Package"
                           "Your program has changed since your last save or load; please save before packaging.")]
              (let ([output-file
                     (finder:put-file (make-reasonable-package-name a-filename)
                                      "Where should the Javascript package be written to?"
                  [(eq? output-file #f)
                   (let ([notify-port 
                           #:title "Creating Javascript Package")])
                     (parameterize ([current-log-port notify-port])
                             (lambda (exn)
                               (fprintf notify-port
                                        "An internal error occurred during compilation: ~a\n"
                                        (exn-message exn))
                               (raise exn))])
                         (let-values ([(ip dont-care)
                                        (make-package-subdirectory-name output-file)
                                        (lambda (output-path)                                 
                                          (fprintf notify-port "Compiling Javascript...\n")
                                          (create-javascript-package a-filename
                           (call-with-output-file output-file
                             (lambda (op) 
                               (fprintf notify-port "Writing package to file ~a...\n" output-file)
                               (copy-port ip op))
                             #:exists 'replace)
                           (fprintf notify-port "Done!\n")))))]))])))
       (let ([racket-menu (get-language-menu)])
         (new separator-menu-item% [parent racket-menu])
         (new menu-item% 
              [parent racket-menu]
              [label "Create Javascript Package"]
              [callback click!]))))))