dunlin/frame.fnl

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