#lang racket/base
(require racket/gui/base
racket/unit
racket/class
framework
drracket/tool
"../js-vm/private/misc.rkt"
"../js-vm/private/notification-window.rkt"
"../js-vm/private/log-port.rkt"
"android/android-packager.ss")
(provide tool@)
(define (make-reasonable-package-name a-path)
(let-values ([(base name dir?)
(split-path a-path)])
(string-append (remove-filename-extension name)
".apk")))
(define (make-package-name a-path)
(let-values ([(base name dir?)
(split-path a-path)])
(remove-filename-extension name)))
(define tool@
(unit
(import drracket:tool^)
(export drracket:tool-exports^)
(define (phase1) (void))
(define (phase2) (void))
(define unit-frame<%> (class->interface drracket:unit:frame%))
(drracket:get/extend:extend-unit-frame
(mixin (unit-frame<%>) (unit-frame<%>)
(inherit get-language-menu
get-definitions-text)
(define (click! a-menu-item a-control-event)
(let* ([a-text (get-definitions-text)]
[a-filename (send a-text get-filename)])
(cond
[(not (path-string? a-filename))
(message-box "Create Phone Package"
"Your program needs to be saved first before packaging.")]
[(send a-text is-modified?)
(message-box "Create Phone Package"
"Your program has changed since your last save or load; please save before packaging.")]
[else
(let ([output-file
(finder:put-file (make-reasonable-package-name a-filename)
#f
#f
"Where should the Phone package be written to?"
)])
(cond
[(eq? output-file #f)
(void)]
[else
(let ([notify-port
(make-notification-window
#:title "Creating Phone Package")])
(parameterize ([current-log-port notify-port])
(with-handlers
([exn:fail?
(lambda (exn)
(fprintf notify-port
"An internal error occurred during compilation: ~a\n"
(exn-message exn))
(raise exn))])
(call-with-output-file output-file
(lambda (op)
(fprintf notify-port
"Writing package to file ~a...\n" output-file)
(write-bytes (build-android-package
(make-package-name output-file)
a-filename)
op))
#:exists 'replace)
(fprintf notify-port "Done!\n"))))]))])))
(super-new)
(let ([racket-menu (get-language-menu)])
(new separator-menu-item% [parent racket-menu])
(new menu-item%
[parent racket-menu]
[label "Create Phone Package"]
[callback click!]))))))