71 lines
2.0 KiB
Scheme
Executable File
71 lines
2.0 KiB
Scheme
Executable File
#! /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:
|