commit 26dfaeb152ed5b5f28f8fba5de2ebf2a6a90f4ab
parent 913050835b2ce4776db2ca4b27e5b9f4fb9f1cac
Author: Daniel Barlow <dan@telent.net>
Date: Thu, 3 Mar 2022 23:07:37 +0000
starting again
Diffstat:
| M | just/just.fnl | | | 389 | +++++++++++++++++-------------------------------------------------------------- |
1 file changed, 84 insertions(+), 305 deletions(-)
diff --git a/just/just.fnl b/just/just.fnl
@@ -3,6 +3,7 @@
(local { : Gtk : Gdk : WebKit2 : cairo } lgi)
+(local {: view} (require :fennel))
(local cache-dir (.. (os.getenv "HOME") "/.cache/just"))
@@ -16,239 +17,88 @@
(.. cache-dir "/cookies.db")
WebKit2.CookiePersistentStorage.SQLITE))
-(fn event-bus []
- (let [subscriptions {}
- vivify (fn [n v]
- (tset n v (or (. n v) []))
- (. n v))]
- {
- :subscribe (fn [self event-name handler]
- (table.insert (vivify subscriptions event-name) handler))
- :publish (fn [self sender event-name payload]
- (each [_ handler (pairs (. subscriptions event-name))]
- (handler sender payload)))
- :unsubscribe (fn [self event-name handler]
- (table.remove (. subscriptions event-name) handler))
- }))
-
+(local
+ Webview
+ {
+ :new
+ #(let [listeners {}
+ notify-listeners (fn [self pspec]
+ (let [n pspec.name
+ funs (. listeners n)]
+ (when funs
+ (each [_ f (ipairs funs)]
+ (f (. self n))))))
+ widget (WebKit2.WebView {
+ :on_notify
+ #(notify-listeners $1 $2)
+ })]
+ ;;(load-adblocks webview.user_content_manager content-filter-store)
+ {
+ :listen (fn [self event-name fun]
+ (let [funs (or (. listeners event-name) [])]
+ (table.insert funs fun)
+ (tset listeners event-name funs)))
+ :visit (fn [self url]
+ (widget:load_uri url))
+ :stop-loading #(widget:stop_loading)
+ :refresh #(widget:reload)
+ :go-back #(and (widget:can_go_back) (widget:go_back))
+
+ :widget widget
+ })
+ })
(fn named-image [name size]
(Gtk.Image.new_from_icon_name
name
(or size Gtk.IconSize.LARGE_TOOLBAR)))
-(fn load-easylist-json [store cb]
- (print "loading easylist from json")
- (with-open [f (io.open "easylist_min_content_blocker.json" "r")]
- (let [blocks (f:read "*a")]
- (store:save "easylist"
- (lgi.GLib.Bytes blocks)
- nil
- (fn [self res]
- (cb (store:save_finish res)))))))
-
-(fn load-adblocks [content-manager store]
- (store:fetch_identifiers
- nil
- (fn [self res]
- (let [ids (store:fetch_identifiers_finish res)
- found (icollect [_ id (pairs ids)] (= id "easylist"))]
- (if (> (# found) 0)
- (store:load "easylist" nil
- (fn [self res]
- (content-manager:add_filter
- (store:load_finish res))))
- (load-easylist-json
- store
- (fn [filter]
- (content-manager:add_filter filter))))))))
-
-(let [css "
-progress, trough {
- max-height: 6px;
- color: #4444bb;
-}
-"
- style_provider (Gtk.CssProvider)]
- (style_provider:load_from_data css)
- (Gtk.StyleContext.add_provider_for_screen
- (lgi.Gdk.Screen.get_default)
- style_provider
- Gtk.STYLE_PROVIDER_PRIORITY_APPLICATION
- ))
-
-
-(fn handle-webview-properties [self pspec bus]
- (match pspec.name
- "uri"
- (bus:publish self :url-changed self.uri)
-
- "title"
- (if (> (self.title:len) 0)
- (bus:publish self :title-changed self.title))
-
- "estimated-load-progress"
- (bus:publish self :loading-progress self.estimated_load_progress)
-
- "is-loading"
- (bus:publish self (if self.is_loading :start-loading :stop-loading))
- ))
-
-(fn new-webview [bus]
- (let [webview (WebKit2.WebView {
- :on_notify
- #(handle-webview-properties $1 $2 bus)
- })]
- (load-adblocks webview.user_content_manager content-filter-store)
- webview))
-
-(fn scale-surface [source]
- (let [image-width 300
- image-height 200
- scaled (cairo.ImageSurface.create
- cairo.Format.ARGB32
- image-width image-height)
- ctx (cairo.Context.create scaled)
- source-width (cairo.ImageSurface.get_width source)
- source-height (cairo.ImageSurface.get_height source)
- scale (/ image-width source-width)]
- ;; XXX do we need to destroy this context? the example
- ;; in C called cairo_destroy(cr), but I haven't found a
- ;; gi equivalent
- (doto ctx
- (: :scale scale scale)
- (: :set_source_surface source 0 0)
- (: :paint))
- scaled))
-
-(fn load-webview-thumbnail [button webview]
- (webview:get_snapshot
- WebKit2.SnapshotRegion.VISIBLE
- WebKit2.SnapshotOptions.NONE
- nil
- (fn [self res]
- (let [surface (webview:get_snapshot_finish res)
- scaled (scale-surface surface)
- img (doto (Gtk.Image) (: :set_from_surface scaled))]
- (button:set_image img)))))
-
-(fn connect-swipe-gesture [widget bus index]
- (Gtk.GestureSwipe {
- :widget widget
- :on_update
- (fn [self]
- (self:set_state Gtk.EventSequenceState.CLAIMED))
- :on_swipe
- (fn [self x y]
- (if (and (< 700 x) (< y 700))
- (bus:publish self :close-tab index)
- (self:set_state Gtk.EventSequenceState.DENIED))
- true)
- }))
-
-
-(fn update-tab-overview [bus tabs scrolledwindow]
- (let [box (Gtk.Box {
- :orientation Gtk.Orientation.VERTICAL
- })]
-
- (each [_ w (ipairs (scrolledwindow:get_children))]
- (scrolledwindow:remove w))
-
- (box:add (Gtk.Label { :label "Open tabs" }))
-
- (each [i w (pairs tabs)]
- (when (> i 0)
- (box:pack_start
- (doto (Gtk.Button {
- :image-position Gtk.PositionType.TOP
- :on_clicked
- #(bus:publish $1 :switch-tab i)
- })
- (connect-swipe-gesture bus i)
- (load-webview-thumbnail w))
- false false 5)))
-
- (box:pack_start (Gtk.Button
- {
- :label " + "
- :width 300
- :height 200
- :on_clicked #(bus:publish $1 :new-tab)
- })
- false false 5)
-
- (scrolledwindow:add box)
- (scrolledwindow:show_all)
- ))
-
-
-(fn pane-cave [bus]
- (let [tabs {}
- widget (Gtk.Notebook {
- :show_tabs false
- :on_switch_page
- (fn [self page num]
- (when (= num 0)
- (update-tab-overview bus tabs page)))
- })
- add-page (fn [v]
- (let [i (widget:append_page v)]
- (tset tabs i v)
- (v:show)
- (set widget.page i)
- v))
- new-tab (fn [self]
- (let [v (add-page (new-webview bus))]
- (v:load_uri "about:blank")
- v))
- tab-overview (Gtk.ScrolledWindow)
- current #(. tabs widget.page)]
- (bus:subscribe :fetch #(match (current) c (c:load_uri $2)))
- (bus:subscribe :stop-loading
- #(match (current) c (c:stop_loading)))
- (bus:subscribe :reload
- #(match (current) c (c:reload)))
- (bus:subscribe :go-back
- #(match (current) c (and (c:can_go_back) (c:go_back))))
-
- (bus:subscribe :new-tab new-tab)
- (bus:subscribe :switch-tab
- (fn [sender index]
- (widget:set_current_page index)
- (let [tab (. tabs index)]
- (when (and tab tab.uri tab.title)
- (bus:publish tab :url-changed tab.uri)
- (bus:publish tab :title-changed tab.title)
- ))))
-
- (bus:subscribe :close-tab
- (fn [sender i]
- (tset tabs i nil)
- (update-tab-overview bus tabs tab-overview)
- (widget:set_current_page 0)))
- (add-page tab-overview)
-
- {
- :new-tab new-tab
- :current-tab current
- :widget widget
- :show-tab-overview (fn []
- (widget:set_current_page 0)
- (bus:publish tab-overview :url-changed false)
- (bus:publish tab-overview :title-changed "Open tabs"))
-
- }))
-
-(local completions
- (doto (Gtk.ListStore)
- (: :set_column_types [lgi.GObject.Type.STRING])))
-
-(fn add-autocomplete-suggestion [url]
- (completions:append [url]))
-
-(let [bus (event-bus)
- window (Gtk.Window {
+(local
+ Navbar
+ {
+ :new
+ (fn [webview]
+ (let [url (Gtk.Entry {
+ ;; :completion (Gtk.EntryCompletion {:model completions :text_column 0 })
+ :on_activate
+ #(webview:visit $1.text)
+ })
+ stop (doto (Gtk.Button {
+ :on_clicked #(webview:stop-loading)
+ })
+ (: :set_image (named-image "process-stop")))
+ refresh (doto (Gtk.Button {
+ :on_clicked #(webview:refresh)
+ })
+ (: :set_image (named-image "view-refresh")))
+ show-tabs (Gtk.Button {
+ :label "><"
+; :on_clicked #(views:show-tab-overview)
+ })
+ back (doto
+ (Gtk.Button {
+ :on_clicked #(webview:go-back)
+ })
+ (: :set_image (named-image "go-previous")))
+ widget (Gtk.Box {
+ :orientation Gtk.Orientation.HORIZONTAL
+ })
+ ]
+ (widget:pack_start back false false 2)
+ (widget:pack_start refresh false false 2)
+ (widget:pack_start stop false false 2)
+ (widget:pack_start url true true 2)
+ (widget:pack_end show-tabs false false 2)
+
+ (webview:listen :uri #(url:set_text $1))
+
+ {
+ :widget widget
+ }))
+ })
+
+
+(let [window (Gtk.Window {
:title "Just browsing"
:default_width 360
:default_height 720
@@ -257,87 +107,16 @@ progress, trough {
container (Gtk.Box {
:orientation Gtk.Orientation.VERTICAL
})
- nav-bar (Gtk.Box {
- :orientation Gtk.Orientation.HORIZONTAL
- })
- progress-bar (Gtk.ProgressBar {
- :orientation Gtk.Orientation.HORIZONTAL
- :fraction 1.0
- :margin 0
- })
- url (Gtk.Entry {
- :completion (Gtk.EntryCompletion {:model completions :text_column 0 })
- :on_activate
- (fn [self] (bus:publish self :fetch self.text))
- })
- stop (doto (Gtk.Button {
- :on_clicked #(bus:publish $1 :stop-loading)
- })
- (: :set_image (named-image "process-stop")))
- refresh (doto (Gtk.Button {
- :on_clicked #(bus:publish $1 :reload)
- })
- (: :set_image (named-image "view-refresh")))
- views (pane-cave bus)
- show-tabs (Gtk.Button {
- :label "><"
- :on_clicked #(views:show-tab-overview)
- })
- back (doto
- (Gtk.Button {
- :on_clicked #(bus:publish $1 :go-back)
- })
- (: :set_image (named-image "go-previous")))
- visible? (fn [tab]
- (= (views:current-tab) tab))]
-
- (bus:subscribe :url-changed
- #(when (visible? $1)
- (doto url
- (: :set_text (or $2 ""))
- (: :set_editable (and $2 true)))))
-
- (bus:subscribe :title-changed
- #(when (visible? $1)
- (window:set_title
- (.. $2 " - Just browsing"))))
+ webview (Webview.new)
+ navbar (Navbar.new webview)
+ ]
- (bus:subscribe :loading-progress
- #(when (visible? $1)
- (tset progress-bar :fraction $2)))
- (bus:subscribe :start-loading
- #(when (visible? $1)
- (stop:show) (refresh:hide)))
- (bus:subscribe :stop-loading
- #(when (visible? $1)
- (stop:hide) (refresh:show)))
-
- (each [_ url (ipairs arg)]
- (views:new-tab))
-
- (nav-bar:pack_start back false false 2)
- (nav-bar:pack_start refresh false false 2)
- (nav-bar:pack_start stop false false 2)
- (nav-bar:pack_start url true true 2)
- (nav-bar:pack_end show-tabs false false 2)
-
- (container:pack_start nav-bar false false 5)
- (container:pack_start progress-bar false false 0)
- (container:pack_start views.widget true true 5)
+ (container:pack_start navbar.widget false false 0)
+ (container:pack_start webview.widget true true 0)
(window:add container)
- (window:show_all)
-
- (bus:subscribe :fetch #(add-autocomplete-suggestion $2))
-
- (each [i url (ipairs arg)]
- (lgi.GLib.timeout_add_seconds
- 0
- (* 2 i)
- (fn []
- (bus:publish window :switch-tab i)
- (bus:publish window :fetch url)
- false))))
+ (webview:visit "https://terse.telent.net/")
+ (window:show_all))
(Gtk.main)
