127 lines
4.5 KiB
Fennel
127 lines
4.5 KiB
Fennel
(local { : Gtk : Gdk : WebKit2 : cairo : GLib : GObject } (require :lgi))
|
|
(local posix (require :posix))
|
|
|
|
(local Listeners (require :just.listeners))
|
|
|
|
;; this is a hack, should find out what XDG says
|
|
(local downloads-directory (.. (os.getenv "HOME") "/" "Downloads"))
|
|
|
|
(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"
|
|
(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))))))))
|
|
|
|
(fn scale-surface [source image-width image-height]
|
|
(let [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 thumbnail-image [widget width height fun]
|
|
;; underlying call is async, so use callback
|
|
(widget:get_snapshot
|
|
WebKit2.SnapshotRegion.VISIBLE
|
|
WebKit2.SnapshotOptions.NONE
|
|
nil
|
|
(fn [self res]
|
|
(let [surface (widget:get_snapshot_finish res)
|
|
scaled (scale-surface surface width height)
|
|
img (doto (Gtk.Image) (: :set_from_surface scaled))]
|
|
(fun img)))))
|
|
|
|
(fn basename [filename]
|
|
(string.match filename "[^/]+$"))
|
|
|
|
(fn spawn-async [vec]
|
|
(let [pid (posix.unistd.fork)]
|
|
(if (> pid 0) true
|
|
(< pid 0) (assert (= "can't fork" nil))
|
|
(do
|
|
(for [f 3 255] (posix.unistd.close f))
|
|
(posix.execp "/usr/bin/env" vec)))))
|
|
|
|
(fn download [uri headers]
|
|
(let [filename
|
|
(match (headers:get_content_disposition)
|
|
(disposition attrs) (basename attrs.filename)
|
|
_ (basename uri))]
|
|
(print :download uri :to filename)
|
|
(spawn-async ["foot"
|
|
"curl"
|
|
uri
|
|
"-o"
|
|
(.. downloads-directory "/" filename)])))
|
|
|
|
{
|
|
:new
|
|
(fn [{: content-filter-store}]
|
|
(let [listeners (Listeners.new)
|
|
props {}
|
|
widget (WebKit2.WebView {
|
|
:on_decide_policy
|
|
(fn [self decision dtype]
|
|
(if (and
|
|
(WebKit2.ResponsePolicyDecision:is_type_of decision)
|
|
(not (decision:is_mime_type_supported)))
|
|
(do
|
|
(download decision.request.uri decision.response.http_headers)
|
|
(decision:ignore)
|
|
true)
|
|
false))
|
|
:on_notify
|
|
(fn [self pspec]
|
|
(when (not (= pspec.name :parent))
|
|
(let [val (. self pspec.name)]
|
|
(tset props pspec.name val)
|
|
(listeners:notify pspec.name val))))
|
|
})]
|
|
(when content-filter-store
|
|
(load-adblocks widget.user_content_manager content-filter-store))
|
|
{
|
|
:listen #(listeners:add $2 $3)
|
|
: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))
|
|
|
|
:thumbnail-image (fn [self width height fun]
|
|
(thumbnail-image widget width height fun))
|
|
|
|
:properties props
|
|
:widget widget
|
|
}))
|
|
}
|