(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 }