private/runtime/gui-library.ss
#lang scheme/base

(require (planet "evector.scm" ("soegaard" "evector.plt" 1))
         (only-in scheme/gui/base message-box)
         srfi/13/string
         "exceptions.ss"
         "value.ss"
         "standard-library.ss")

(provide install-gui-library!)

(define js:alert
  (build-function 1
    (lambda (args)
      (let ([args (evector->list args)])
        (when (null? args)
          (raise-runtime-exception here "not enough arguments"))
        (let* ([msg (value->string (car args))]
               [msg-padded (if (< (string-length msg) 20)
                               (string-pad-right msg 20 #\space)
                               msg)])
          (message-box "JavaScript" msg-padded #f '(ok)))
        (void)))))

(define global-methods
  `((alert ,js:alert)))

(define (install-gui-library! global)
  (install-properties! global global-methods)
  global)