#! /bin/sh
exec guile -L . -e main -s "$0" "$@"
!#
(use-modules (rnrs bytevectors)
             (ice-9 binary-ports)
             (srfi srfi-26)
             (scmvm vm))

(define the-vm #f)
(define the-program #f)

(define (load-binary port)
  (set! the-vm (make-vm))
  (set! the-program port))

(eval-when (expand load eval)
  (use-modules (oop goops)
               (g-golf))
  (g-irepository-require "Gtk" #:version "4.0")
  (for-each (lambda (name)
              (gi-import-by-name "Gio" name))
            '("SimpleAction"
              "SimpleActionGroup"))
  (for-each (lambda (name) (gi-import-by-name "Gtk" name))
            '("Application"
              "ApplicationWindow"
              "CallbackAction"
              "FileDialog")))

(define (open-file win cb)
  (define dialog (make <gtk-file-dialog>))
  (define (cb-with-port dialog result data)
    (call-with-input-file (get-path (open-finish dialog result)) cb))
  (open dialog win #f cb-with-port #f))

(define (install-action action-group name callback)
  (define action (make <g-simple-action> #:name name))
  (add-action action-group action)
  (connect action 'activate (lambda (a v) (callback))))

(define (activate app)
  (define win (make <gtk-application-window>
                #:application app
                #:title "Scheme Compiler"))

  ;; All this to make a menu...
  (let ([app-action-group (make <g-simple-action-group>)]
        [menu (make <g-menu>)]
        [file-menu (make <g-menu>)])
    (append file-menu "Open..." "app.open-file")
    (append-submenu menu "File" file-menu)
    (set-menubar app menu)
    (set-show-menubar win #t)
    (insert-action-group win "app" app-action-group)
    (install-action
     app-action-group
     "open-file"
     (lambda ()
       (open-file win load-binary))))
  (present win))

(define* (main #:optional args)
  (define app (make <gtk-application>))
  (connect app 'activate activate)
  (let ([status (run app args)])
    (exit status)))

;; Local Variables:
;; mode: scheme
;; End: