rudimentary support for downloads
This commit is contained in:
parent
da435b0667
commit
aa2c23a48e
@ -1,7 +1,11 @@
|
|||||||
(local { : Gtk : Gdk : WebKit2 : cairo : GLib } (require :lgi))
|
(local { : Gtk : Gdk : WebKit2 : cairo : GLib : GObject } (require :lgi))
|
||||||
|
(local posix (require :posix))
|
||||||
|
|
||||||
(local Listeners (require :listeners))
|
(local Listeners (require :listeners))
|
||||||
|
|
||||||
|
;; this is a hack, should find out what XDG says
|
||||||
|
(local downloads-directory (.. (os.getenv "HOME") "/" "Downloads"))
|
||||||
|
|
||||||
(fn load-easylist-json [store cb]
|
(fn load-easylist-json [store cb]
|
||||||
(print "loading easylist from json")
|
(print "loading easylist from json")
|
||||||
(with-open [f (io.open "easylist_min_content_blocker.json" "r")]
|
(with-open [f (io.open "easylist_min_content_blocker.json" "r")]
|
||||||
@ -57,6 +61,28 @@
|
|||||||
img (doto (Gtk.Image) (: :set_from_surface scaled))]
|
img (doto (Gtk.Image) (: :set_from_surface scaled))]
|
||||||
(fun img)))))
|
(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
|
:new
|
||||||
@ -64,6 +90,16 @@
|
|||||||
(let [listeners (Listeners.new)
|
(let [listeners (Listeners.new)
|
||||||
props {}
|
props {}
|
||||||
widget (WebKit2.WebView {
|
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
|
:on_notify
|
||||||
(fn [self pspec]
|
(fn [self pspec]
|
||||||
(when (not (= pspec.name :parent))
|
(when (not (= pspec.name :parent))
|
||||||
|
Loading…
Reference in New Issue
Block a user