dunlin

Unnamed repository; edit this file 'description' to name the repository.
Log | Files | Refs | README | LICENSE

frame.fnl (4014B)

      1 (local { : Gtk : Gdk : WebKit2 : cairo } (require :lgi))
      2 (local { : view } (require :fennel))
      3 (local lume (require :lume))
      4 
      5 (local Command (require :command))
      6 (local keymap (require :keymap))
      7 
      8 (var frames [])
      9 
     10 (fn new-frame [global-keymap]
     11   (let [hpad 2
     12         vpad 2
     13         self {}
     14         recogniser (keymap.recogniser global-keymap)
     15         bottom-line (Gtk.Stack {
     16                                 :transition_type Gtk.StackTransitionType.SLIDE_UP_DOWN
     17                                 :transition_duration 100
     18                                 })
     19         commander (Command.commander self)
     20         echo-area (Gtk.Label {
     21                               :xalign 0
     22                               :margin_start 10
     23                               })
     24         window (Gtk.Window {
     25                             :title "Dunlin"
     26                             :default_width 800
     27                             :default_height 720
     28                             :on_destroy Gtk.main_quit
     29                             })
     30         container (Gtk.Box {
     31                             :orientation Gtk.Orientation.VERTICAL
     32                             })
     33         progress-bar (Gtk.ProgressBar {
     34                                        :orientation Gtk.Orientation.HORIZONTAL
     35                                        :fraction 1.0
     36                                        :margin 0
     37                                        })
     38         contentwidget (Gtk.Box {
     39                                 :orientation Gtk.Orientation.VERTICAL
     40                                 })
     41         update-prop (fn [props name value]
     42                       (match name
     43                         :estimated-load-progress
     44                         (tset progress-bar :fraction value)
     45                         :uri
     46                         (do (tset echo-area :label value)
     47                             (_G.history:visit value (os.time)))
     48                         :title
     49                         (_G.history:title self.buffer.properties.uri value)
     50                         n
     51                         (comment (print "prop change" n value))))]
     52 
     53     (doto bottom-line
     54       (: :add_named echo-area "echo-area")
     55       (: :add_named commander.widget "commander")
     56       (: :set_visible_child_name "commander"))
     57 
     58     (doto container
     59       (: :pack_start progress-bar false false vpad)
     60       (: :pack_start contentwidget true true vpad)
     61       (: :pack_end bottom-line false false vpad))
     62 
     63     (tset window :on_key_release_event
     64           (fn [window event]
     65             (when (not (commander:active?))
     66               (match (recogniser:accept-event event)
     67                 [name params] (commander:invoke-interactively name params)
     68                 (nil prompt) (tset echo-area :label prompt)))
     69             (when (and (commander:active?)
     70                        (= keymap.keyval.Escape event.keyval))
     71               (commander:deactivate))
     72 
     73             (when (and event.state.MOD1_MASK
     74                        (= event.keyval (string.byte "x")))
     75               (commander:activate))))
     76 
     77     (echo-area:show) (commander.widget:show)
     78 
     79 
     80     (window:add container)
     81     (window:show_all)
     82     (let [f
     83           {
     84            :window window
     85            :buffer nil
     86            :content contentwidget
     87            :message (fn [self message]
     88                       (tset echo-area :label message))
     89            :show-buffer (fn [self b]
     90                           (each [_ w (pairs (contentwidget:get_children))]
     91                             (w:hide))
     92                           (tset self :buffer b)
     93                           (contentwidget:pack_start b.webview true true 0)
     94                           (b:subscribe-property-changes
     95                            (fn [name val]
     96                              (if (= b self.buffer)
     97                                  (update-prop self name val)
     98                                  (print "ignore props from background" b))))
     99                           (b.webview:show))
    100            }]
    101       (lume.extend self f)
    102       (table.insert frames self)
    103       self)))
    104 
    105 
    106 { :new new-frame :frames frames }