dunlin/frame.fnl

107 lines
3.9 KiB
Fennel

(local { : Gtk : Gdk : WebKit2 : cairo } (require :lgi))
(local { : view } (require :fennel))
(local lume (require :lume))
(local Command (require :command))
(local keymap (require :keymap))
(var frames [])
(fn new-frame [global-keymap]
(let [hpad 2
vpad 2
self {}
recogniser (keymap.recogniser global-keymap)
bottom-line (Gtk.Stack {
:transition_type Gtk.StackTransitionType.SLIDE_UP_DOWN
:transition_duration 100
})
commander (Command.commander self)
echo-area (Gtk.Label {
:xalign 0
:margin_start 10
})
window (Gtk.Window {
:title "Dunlin"
:default_width 800
:default_height 720
:on_destroy Gtk.main_quit
})
container (Gtk.Box {
:orientation Gtk.Orientation.VERTICAL
})
progress-bar (Gtk.ProgressBar {
:orientation Gtk.Orientation.HORIZONTAL
:fraction 1.0
:margin 0
})
contentwidget (Gtk.Box {
:orientation Gtk.Orientation.VERTICAL
})
update-prop (fn [props name value]
(match name
:estimated-load-progress
(tset progress-bar :fraction value)
:uri
(do (tset echo-area :label value)
(_G.history:visit value (os.time)))
:title
(_G.history:title self.buffer.properties.uri value)
n
(comment (print "prop change" n value))))]
(doto bottom-line
(: :add_named echo-area "echo-area")
(: :add_named commander.widget "commander")
(: :set_visible_child_name "commander"))
(doto container
(: :pack_start progress-bar false false vpad)
(: :pack_start contentwidget true true vpad)
(: :pack_end bottom-line false false vpad))
(tset window :on_key_release_event
(fn [window event]
(when (not (commander:active?))
(match (recogniser:accept-event event)
[name params] (commander:invoke-interactively name params)
(nil prompt) (tset echo-area :label prompt)))
(when (and (commander:active?)
(= keymap.keyval.Escape event.keyval))
(commander:deactivate))
(when (and event.state.MOD1_MASK
(= event.keyval (string.byte "x")))
(commander:activate))))
(echo-area:show) (commander.widget:show)
(window:add container)
(window:show_all)
(let [f
{
:window window
:buffer nil
:content contentwidget
:message (fn [self message]
(tset echo-area :label message))
:show-buffer (fn [self b]
(each [_ w (pairs (contentwidget:get_children))]
(w:hide))
(tset self :buffer b)
(contentwidget:pack_start b.webview true true 0)
(b:subscribe-property-changes
(fn [name val]
(if (= b self.buffer)
(update-prop self name val)
(print "ignore props from background" b))))
(b.webview:show))
}]
(lume.extend self f)
(table.insert frames self)
self)))
{ :new new-frame :frames frames }