From 913050835b2ce4776db2ca4b27e5b9f4fb9f1cac Mon Sep 17 00:00:00 2001 From: Daniel Barlow Date: Sun, 20 Feb 2022 12:25:59 +0000 Subject: [PATCH 01/27] use destructuring in module requires --- just/just.fnl | 6 ++---- 1 file changed, 2 insertions(+), 4 deletions(-) diff --git a/just/just.fnl b/just/just.fnl index 070ce42..d32ae4f 100644 --- a/just/just.fnl +++ b/just/just.fnl @@ -1,10 +1,8 @@ (local lgi (require :lgi)) (local inspect (require :inspect)) -(local Gtk lgi.Gtk) -(local Gdk lgi.Gdk) -(local WebKit2 lgi.WebKit2) -(local cairo lgi.cairo) +(local { : Gtk : Gdk : WebKit2 : cairo } lgi) + (local cache-dir (.. (os.getenv "HOME") "/.cache/just")) From 26dfaeb152ed5b5f28f8fba5de2ebf2a6a90f4ab Mon Sep 17 00:00:00 2001 From: Daniel Barlow Date: Thu, 3 Mar 2022 23:07:37 +0000 Subject: [PATCH 02/27] starting again --- just/just.fnl | 379 +++++++++++--------------------------------------- 1 file changed, 79 insertions(+), 300 deletions(-) diff --git a/just/just.fnl b/just/just.fnl index d32ae4f..28aae5a 100644 --- 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))))))) +(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) -(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)))))))) + (webview:listen :uri #(url:set_text $1)) -(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 - )) + { + :widget widget + })) + }) -(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 { +(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))] + webview (Webview.new) + navbar (Navbar.new webview) + ] - (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")))) - - (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) From 8679518ca3434f7353490a75dfbd0eeccf547cc2 Mon Sep 17 00:00:00 2001 From: Daniel Barlow Date: Fri, 4 Mar 2022 00:01:48 +0000 Subject: [PATCH 03/27] extract notify-listeners and listen to functions --- just/just.fnl | 26 +++++++++++++++----------- 1 file changed, 15 insertions(+), 11 deletions(-) diff --git a/just/just.fnl b/just/just.fnl index 28aae5a..b77f027 100644 --- a/just/just.fnl +++ b/just/just.fnl @@ -17,27 +17,31 @@ (.. cache-dir "/cookies.db") WebKit2.CookiePersistentStorage.SQLITE)) +(fn notify-listeners [listeners name value] + (let [funs (. listeners name)] + (when funs + (each [_ f (ipairs funs)] + (f value))))) + +(fn add-listener [listeners event-name fun] + (let [funs (or (. listeners event-name) [])] + (table.insert funs fun) + (tset listeners event-name funs))) + (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) + (fn [self pspec] + (when (not (= pspec.name :parent)) + (notify-listeners listeners pspec.name (. self pspec.name)))) })] ;;(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))) + :listen #(add-listener listeners $2 $3) :visit (fn [self url] (widget:load_uri url)) :stop-loading #(widget:stop_loading) From 468ed240b4e4cf94c4c2826eb56c9256429178ab Mon Sep 17 00:00:00 2001 From: Daniel Barlow Date: Fri, 4 Mar 2022 00:02:16 +0000 Subject: [PATCH 04/27] add Viewplex, basis for supporting multiple webviews --- just/just.fnl | 36 ++++++++++++++++++++++++++++++++++-- 1 file changed, 34 insertions(+), 2 deletions(-) diff --git a/just/just.fnl b/just/just.fnl index b77f027..acfd4b1 100644 --- a/just/just.fnl +++ b/just/just.fnl @@ -52,6 +52,36 @@ }) }) +(local + Viewplex + { + :new + #(let [listeners {} + widget (Gtk.Notebook { + :show_tabs false + ;;# :on_switch_page + })] + (var foreground-view nil) + (print :viewplex widget) + { + :listen #(add-listener listeners $2 $3) + :widget widget + :add-view (fn [self webview] + (set foreground-view webview) + (webview.widget:show) + (set widget.page + (widget:append_page webview.widget))) + :visit #(and foreground-view (foreground-view:visit $2)) + :stop-loading #(and foreground-view + (foreground-view:stop-loading)) + :refresh #(and foreground-view (foreground-view:refresh)) + :go-back #(and foreground-view (foreground-view:go-back)) + }) + }) + + + + (fn named-image [name size] (Gtk.Image.new_from_icon_name name @@ -111,12 +141,14 @@ container (Gtk.Box { :orientation Gtk.Orientation.VERTICAL }) + viewplex (Viewplex.new) webview (Webview.new) - navbar (Navbar.new webview) + navbar (Navbar.new viewplex) ] (container:pack_start navbar.widget false false 0) - (container:pack_start webview.widget true true 0) + (container:pack_start viewplex.widget true true 0) + (viewplex:add-view webview) (window:add container) From fc7de29d80c352f6e7826ab0597919f254c7ad47 Mon Sep 17 00:00:00 2001 From: Daniel Barlow Date: Fri, 4 Mar 2022 23:16:42 +0000 Subject: [PATCH 05/27] create Listeners module/class/thing --- just/just.fnl | 37 +++++++++++++++++++++---------------- 1 file changed, 21 insertions(+), 16 deletions(-) diff --git a/just/just.fnl b/just/just.fnl index acfd4b1..ac1e3cf 100644 --- a/just/just.fnl +++ b/just/just.fnl @@ -17,31 +17,37 @@ (.. cache-dir "/cookies.db") WebKit2.CookiePersistentStorage.SQLITE)) -(fn notify-listeners [listeners name value] - (let [funs (. listeners name)] - (when funs - (each [_ f (ipairs funs)] - (f value))))) - -(fn add-listener [listeners event-name fun] - (let [funs (or (. listeners event-name) [])] - (table.insert funs fun) - (tset listeners event-name funs))) +(local + Listeners + { + :new + #(let [listeners {}] + { + :notify (fn [_ name value] + (let [funs (. listeners name)] + (when funs + (each [_ f (ipairs funs)] + (f value))))) + :add (fn [_ event-name fun] + (let [funs (or (. listeners event-name) [])] + (table.insert funs fun) + (tset listeners event-name funs))) + })}) (local Webview { :new - #(let [listeners {} + #(let [listeners (Listeners.new) widget (WebKit2.WebView { :on_notify (fn [self pspec] (when (not (= pspec.name :parent)) - (notify-listeners listeners pspec.name (. self pspec.name)))) + (listeners:notify pspec.name (. self pspec.name)))) })] ;;(load-adblocks webview.user_content_manager content-filter-store) { - :listen #(add-listener listeners $2 $3) + :listen #(listeners:add $2 $3) :visit (fn [self url] (widget:load_uri url)) :stop-loading #(widget:stop_loading) @@ -56,15 +62,14 @@ Viewplex { :new - #(let [listeners {} + #(let [listeners (Listeners.new) widget (Gtk.Notebook { :show_tabs false ;;# :on_switch_page })] (var foreground-view nil) - (print :viewplex widget) { - :listen #(add-listener listeners $2 $3) + :listen #(listeners:add $2 $3) :widget widget :add-view (fn [self webview] (set foreground-view webview) From 140cac0dfe76b665100f902a18394b6897faff0f Mon Sep 17 00:00:00 2001 From: Daniel Barlow Date: Fri, 4 Mar 2022 23:17:21 +0000 Subject: [PATCH 06/27] Viewplex listens for :uri webview events and relays them --- just/just.fnl | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/just/just.fnl b/just/just.fnl index ac1e3cf..740a357 100644 --- a/just/just.fnl +++ b/just/just.fnl @@ -74,6 +74,7 @@ :add-view (fn [self webview] (set foreground-view webview) (webview.widget:show) + (webview:listen :uri #(listeners:notify :uri $1)) (set widget.page (widget:append_page webview.widget))) :visit #(and foreground-view (foreground-view:visit $2)) @@ -146,8 +147,8 @@ container (Gtk.Box { :orientation Gtk.Orientation.VERTICAL }) - viewplex (Viewplex.new) webview (Webview.new) + viewplex (Viewplex.new) navbar (Navbar.new viewplex) ] @@ -157,7 +158,7 @@ (window:add container) - (webview:visit "https://terse.telent.net/") + (viewplex:visit "https://terse.telent.net/") (window:show_all)) (Gtk.main) From a8345a1734c0b65b9073148dd156886e2be74f65 Mon Sep 17 00:00:00 2001 From: Daniel Barlow Date: Sat, 5 Mar 2022 18:23:58 +0000 Subject: [PATCH 07/27] make viewplex track the events it should relay for --- just/just.fnl | 59 ++++++++++++++++++++++++++++++--------------------- 1 file changed, 35 insertions(+), 24 deletions(-) diff --git a/just/just.fnl b/just/just.fnl index 740a357..8c4fc4e 100644 --- a/just/just.fnl +++ b/just/just.fnl @@ -60,30 +60,41 @@ (local Viewplex - { - :new - #(let [listeners (Listeners.new) - widget (Gtk.Notebook { - :show_tabs false - ;;# :on_switch_page - })] - (var foreground-view nil) - { - :listen #(listeners:add $2 $3) - :widget widget - :add-view (fn [self webview] - (set foreground-view webview) - (webview.widget:show) - (webview:listen :uri #(listeners:notify :uri $1)) - (set widget.page - (widget:append_page webview.widget))) - :visit #(and foreground-view (foreground-view:visit $2)) - :stop-loading #(and foreground-view - (foreground-view:stop-loading)) - :refresh #(and foreground-view (foreground-view:refresh)) - :go-back #(and foreground-view (foreground-view:go-back)) - }) - }) + (let [relay-events []] + { + :new + #(let [listeners (Listeners.new) + widget (Gtk.Notebook { + :show_tabs false + ;;# :on_switch_page + }) + views []] + (var foreground-view nil) + { + :listen (fn [_ name fun] + (if (not (. relay-events name)) + (each [_ v (ipairs views)] + (v:listen name #(listeners:notify name $1)))) + (table.insert relay-events name) + (listeners:add name fun)) + :widget widget + :add-view (fn [self webview] + (set foreground-view webview) + (webview.widget:show) + (table.insert views webview) + (each [_ event-name (ipairs relay-events)] + (webview:listen event-name + #(listeners:notify event-name $1))) + (set widget.page + (widget:append_page webview.widget))) + :visit #(and foreground-view (foreground-view:visit $2)) + :stop-loading #(and foreground-view + (foreground-view:stop-loading)) + :refresh #(and foreground-view (foreground-view:refresh)) + :go-back #(and foreground-view (foreground-view:go-back)) + } + )})) + From f225793fb0a4e8c62982bb317e0e5e870d28a9b8 Mon Sep 17 00:00:00 2001 From: Daniel Barlow Date: Sat, 5 Mar 2022 18:52:17 +0000 Subject: [PATCH 08/27] extract Listeners, Viewplex, Webview to separate modules --- just/just.fnl | 83 +++------------------------------------------- just/listeners.fnl | 14 ++++++++ just/viewplex.fnl | 38 +++++++++++++++++++++ just/webview.fnl | 30 +++++++++++++++++ 4 files changed, 86 insertions(+), 79 deletions(-) create mode 100644 just/listeners.fnl create mode 100644 just/viewplex.fnl create mode 100644 just/webview.fnl diff --git a/just/just.fnl b/just/just.fnl index 8c4fc4e..1dddb41 100644 --- a/just/just.fnl +++ b/just/just.fnl @@ -5,6 +5,10 @@ (local {: view} (require :fennel)) +(local Listeners (require :listeners)) +(local Webview (require :webview)) +(local Viewplex (require :viewplex)) + (local cache-dir (.. (os.getenv "HOME") "/.cache/just")) (local content-filter-store @@ -17,85 +21,6 @@ (.. cache-dir "/cookies.db") WebKit2.CookiePersistentStorage.SQLITE)) -(local - Listeners - { - :new - #(let [listeners {}] - { - :notify (fn [_ name value] - (let [funs (. listeners name)] - (when funs - (each [_ f (ipairs funs)] - (f value))))) - :add (fn [_ event-name fun] - (let [funs (or (. listeners event-name) [])] - (table.insert funs fun) - (tset listeners event-name funs))) - })}) - -(local - Webview - { - :new - #(let [listeners (Listeners.new) - widget (WebKit2.WebView { - :on_notify - (fn [self pspec] - (when (not (= pspec.name :parent)) - (listeners:notify pspec.name (. self pspec.name)))) - })] - ;;(load-adblocks webview.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)) - - :widget widget - }) - }) - -(local - Viewplex - (let [relay-events []] - { - :new - #(let [listeners (Listeners.new) - widget (Gtk.Notebook { - :show_tabs false - ;;# :on_switch_page - }) - views []] - (var foreground-view nil) - { - :listen (fn [_ name fun] - (if (not (. relay-events name)) - (each [_ v (ipairs views)] - (v:listen name #(listeners:notify name $1)))) - (table.insert relay-events name) - (listeners:add name fun)) - :widget widget - :add-view (fn [self webview] - (set foreground-view webview) - (webview.widget:show) - (table.insert views webview) - (each [_ event-name (ipairs relay-events)] - (webview:listen event-name - #(listeners:notify event-name $1))) - (set widget.page - (widget:append_page webview.widget))) - :visit #(and foreground-view (foreground-view:visit $2)) - :stop-loading #(and foreground-view - (foreground-view:stop-loading)) - :refresh #(and foreground-view (foreground-view:refresh)) - :go-back #(and foreground-view (foreground-view:go-back)) - } - )})) - - diff --git a/just/listeners.fnl b/just/listeners.fnl new file mode 100644 index 0000000..89cce94 --- /dev/null +++ b/just/listeners.fnl @@ -0,0 +1,14 @@ +{ + :new + #(let [listeners {}] + { + :notify (fn [_ name value] + (let [funs (. listeners name)] + (when funs + (each [_ f (ipairs funs)] + (f value))))) + :add (fn [_ event-name fun] + (let [funs (or (. listeners event-name) [])] + (table.insert funs fun) + (tset listeners event-name funs))) + })} diff --git a/just/viewplex.fnl b/just/viewplex.fnl new file mode 100644 index 0000000..0cc6b1a --- /dev/null +++ b/just/viewplex.fnl @@ -0,0 +1,38 @@ +(local { : Gtk : Gdk : WebKit2 : cairo } (require :lgi)) + +(local Listeners (require :listeners)) + +{ + :new + #(let [listeners (Listeners.new) + relay-events [] + widget (Gtk.Notebook { + :show_tabs false + ;;# :on_switch_page + }) + views []] + (var foreground-view nil) + { + :listen (fn [_ name fun] + (if (not (. relay-events name)) + (each [_ v (ipairs views)] + (v:listen name #(listeners:notify name $1)))) + (table.insert relay-events name) + (listeners:add name fun)) + :widget widget + :add-view (fn [self webview] + (set foreground-view webview) + (webview.widget:show) + (table.insert views webview) + (each [_ event-name (ipairs relay-events)] + (webview:listen event-name + #(listeners:notify event-name $1))) + (set widget.page + (widget:append_page webview.widget))) + :visit #(and foreground-view (foreground-view:visit $2)) + :stop-loading #(and foreground-view + (foreground-view:stop-loading)) + :refresh #(and foreground-view (foreground-view:refresh)) + :go-back #(and foreground-view (foreground-view:go-back)) + } + )} diff --git a/just/webview.fnl b/just/webview.fnl new file mode 100644 index 0000000..59a46a3 --- /dev/null +++ b/just/webview.fnl @@ -0,0 +1,30 @@ +(local { : Gtk : Gdk : WebKit2 : cairo } (require :lgi)) + +(local Listeners (require :listeners)) + + +{ + :new + #(let [listeners (Listeners.new) + props {} + widget (WebKit2.WebView { + :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)))) + })] + ;;(load-adblocks webview.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)) + + :properties props + :widget widget + }) + } From 24052ac10deef63efd16c3538e14f18f47678d16 Mon Sep 17 00:00:00 2001 From: Daniel Barlow Date: Sat, 5 Mar 2022 23:04:24 +0000 Subject: [PATCH 09/27] viewplex: index views by Notebook page number --- just/just.fnl | 3 --- just/viewplex.fnl | 11 ++++++----- 2 files changed, 6 insertions(+), 8 deletions(-) diff --git a/just/just.fnl b/just/just.fnl index 1dddb41..80a39cf 100644 --- a/just/just.fnl +++ b/just/just.fnl @@ -21,9 +21,6 @@ (.. cache-dir "/cookies.db") WebKit2.CookiePersistentStorage.SQLITE)) - - - (fn named-image [name size] (Gtk.Image.new_from_icon_name name diff --git a/just/viewplex.fnl b/just/viewplex.fnl index 0cc6b1a..207e5ce 100644 --- a/just/viewplex.fnl +++ b/just/viewplex.fnl @@ -10,25 +10,26 @@ :show_tabs false ;;# :on_switch_page }) - views []] + views {}] (var foreground-view nil) { :listen (fn [_ name fun] (if (not (. relay-events name)) - (each [_ v (ipairs views)] (v:listen name #(listeners:notify name $1)))) + (each [_ v (pairs views)] (table.insert relay-events name) (listeners:add name fun)) :widget widget :add-view (fn [self webview] (set foreground-view webview) (webview.widget:show) - (table.insert views webview) (each [_ event-name (ipairs relay-events)] (webview:listen event-name #(listeners:notify event-name $1))) - (set widget.page - (widget:append_page webview.widget))) + (let [page (widget:append_page webview.widget)] + (tset views page webview) + (set widget.page page) + page)) :visit #(and foreground-view (foreground-view:visit $2)) :stop-loading #(and foreground-view (foreground-view:stop-loading)) From 1ba470a63113adc4e72fd550ac9e6a4145ea5a59 Mon Sep 17 00:00:00 2001 From: Daniel Barlow Date: Sat, 5 Mar 2022 23:05:03 +0000 Subject: [PATCH 10/27] viewplex: only relay events from focused page --- just/viewplex.fnl | 13 ++++++++++++- 1 file changed, 12 insertions(+), 1 deletion(-) diff --git a/just/viewplex.fnl b/just/viewplex.fnl index 207e5ce..e59517b 100644 --- a/just/viewplex.fnl +++ b/just/viewplex.fnl @@ -15,11 +15,14 @@ { :listen (fn [_ name fun] (if (not (. relay-events name)) - (v:listen name #(listeners:notify name $1)))) (each [_ v (pairs views)] + (v:listen name #(if (= v foreground-view) + (listeners:notify name $1))))) (table.insert relay-events name) (listeners:add name fun)) + :widget widget + :add-view (fn [self webview] (set foreground-view webview) (webview.widget:show) @@ -30,6 +33,14 @@ (tset views page webview) (set widget.page page) page)) + + :focus (fn [_ page] + (let [view (. views page)] + (set foreground-view view) + (each [_ prop (ipairs relay-events)] + (listeners:notify :uri (. view.properties prop))) + (set widget.page page))) + :visit #(and foreground-view (foreground-view:visit $2)) :stop-loading #(and foreground-view (foreground-view:stop-loading)) From f5503c38389eddda46eb85a6710947888671a428 Mon Sep 17 00:00:00 2001 From: Daniel Barlow Date: Sun, 6 Mar 2022 17:46:51 +0000 Subject: [PATCH 11/27] implement pane chooser --- just/just.fnl | 12 ++- just/shell.nix | 4 +- just/viewplex.fnl | 186 ++++++++++++++++++++++++++++++++++++---------- 3 files changed, 157 insertions(+), 45 deletions(-) diff --git a/just/just.fnl b/just/just.fnl index 80a39cf..ce651db 100644 --- a/just/just.fnl +++ b/just/just.fnl @@ -46,7 +46,7 @@ (: :set_image (named-image "view-refresh"))) show-tabs (Gtk.Button { :label "><" -; :on_clicked #(views:show-tab-overview) + :on_clicked #(webview:show-pages) }) back (doto (Gtk.Button { @@ -80,18 +80,22 @@ container (Gtk.Box { :orientation Gtk.Orientation.VERTICAL }) - webview (Webview.new) viewplex (Viewplex.new) navbar (Navbar.new viewplex) ] (container:pack_start navbar.widget false false 0) (container:pack_start viewplex.widget true true 0) - (viewplex:add-view webview) + + (each [_ url (ipairs arg)] + (let [v (Webview.new)] + (v:visit url) + (viewplex:add-view v))) (window:add container) - (viewplex:visit "https://terse.telent.net/") +; (lgi.GLib.timeout_add_seconds 0 3 #(viewplex:focus one))) + (window:show_all)) (Gtk.main) diff --git a/just/shell.nix b/just/shell.nix index a760f25..0ba0690 100644 --- a/just/shell.nix +++ b/just/shell.nix @@ -1 +1,3 @@ -with import {} ; callPackage ./. {} +with import {} ; +let just = callPackage ./. {}; +in just.overrideAttrs(o: { JUST_HACKING = 1; }) diff --git a/just/viewplex.fnl b/just/viewplex.fnl index e59517b..592dfb0 100644 --- a/just/viewplex.fnl +++ b/just/viewplex.fnl @@ -2,49 +2,155 @@ (local Listeners (require :listeners)) +(local thumbnail-width 300) +(local thumbnail-height 200) + +(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 webview-thumbnail-image [webview-widget fun] + ;; underlying call is async, so use callback + (webview-widget:get_snapshot + WebKit2.SnapshotRegion.VISIBLE + WebKit2.SnapshotOptions.NONE + nil + (fn [self res] + (let [surface (webview-widget:get_snapshot_finish res) + scaled (scale-surface surface thumbnail-width thumbnail-height) + img (doto (Gtk.Image) (: :set_from_surface scaled))] + (fun img))))) + +(fn on-fake-swipe [widget fun] + ;; this is here for testing on desktop systems that don't + ;; have touch support + (Gtk.GestureLongPress { + :widget widget + :on_pressed fun + })) + +(fn on-swipe [widget fun] + (if (os.getenv "JUST_HACKING") (on-fake-swipe widget fun)) + + (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)) + (fun) + (self:set_state Gtk.EventSequenceState.DENIED)) + true) + })) + +(fn refresh-overview [self scrolledwindow views] + (let [box (Gtk.Box { + :orientation Gtk.Orientation.VERTICAL + })] + + (each [_ w (ipairs (scrolledwindow:get_children))] + (scrolledwindow:remove w)) + + (each [i w (pairs views)] + (box:pack_start + (let [b (Gtk.Button { + :label w.properties.title + :width thumbnail-width + :height thumbnail-height + :image-position Gtk.PositionType.TOP + :on_clicked #(self:focus w) + })] + (on-swipe b #(self:remove-view w)) + (webview-thumbnail-image w.widget #(b:set_image $1)) + b) + 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) + )) + + { :new - #(let [listeners (Listeners.new) - relay-events [] - widget (Gtk.Notebook { - :show_tabs false - ;;# :on_switch_page - }) - views {}] - (var foreground-view nil) - { - :listen (fn [_ name fun] - (if (not (. relay-events name)) - (each [_ v (pairs views)] - (v:listen name #(if (= v foreground-view) - (listeners:notify name $1))))) - (table.insert relay-events name) - (listeners:add name fun)) + (fn [] + (var foreground-view nil) + (let [listeners (Listeners.new) + relay-events [] + widget (Gtk.Notebook { + :show_tabs false + }) + overview (Gtk.ScrolledWindow) + overview-page (widget:append_page overview) + views {}] + { + :listen (fn [_ name fun] + (if (not (. relay-events name)) + (each [_ v (pairs views)] + (v:listen name #(if (= v foreground-view) + (listeners:notify name $1))))) + (table.insert relay-events name) + (listeners:add name fun)) - :widget widget + :widget widget - :add-view (fn [self webview] - (set foreground-view webview) - (webview.widget:show) - (each [_ event-name (ipairs relay-events)] - (webview:listen event-name - #(listeners:notify event-name $1))) - (let [page (widget:append_page webview.widget)] - (tset views page webview) - (set widget.page page) - page)) + :add-view (fn [self webview] + (set foreground-view webview) + (webview.widget:show) + (each [_ event-name (ipairs relay-events)] + (webview:listen event-name + #(listeners:notify event-name $1))) + (let [page (widget:append_page webview.widget)] + (tset views page webview) + (set widget.page page) + page)) - :focus (fn [_ page] - (let [view (. views page)] - (set foreground-view view) - (each [_ prop (ipairs relay-events)] - (listeners:notify :uri (. view.properties prop))) - (set widget.page page))) + :remove-view (fn [self view] + (let [page (widget:page_num view.widget)] + (tset views page nil) + (widget:remove_page page) + (self:show-pages) + )) - :visit #(and foreground-view (foreground-view:visit $2)) - :stop-loading #(and foreground-view - (foreground-view:stop-loading)) - :refresh #(and foreground-view (foreground-view:refresh)) - :go-back #(and foreground-view (foreground-view:go-back)) - } - )} + :focus (fn [_ view] + (when view + (set foreground-view view) + (each [_ prop (ipairs relay-events)] + (listeners:notify prop (. view.properties prop))) + (set widget.page (widget:page_num view.widget)))) + + :show-pages (fn [self] + (set foreground-view nil) + (set widget.page overview-page) + (refresh-overview self overview views)) + + :visit #(and foreground-view (foreground-view:visit $2)) + :stop-loading #(and foreground-view + (foreground-view:stop-loading)) + :refresh #(and foreground-view (foreground-view:refresh)) + :go-back #(and foreground-view (foreground-view:go-back)) + } + ))} From 8567c4d81c44bd756dd4a0969eac489b93d07e6d Mon Sep 17 00:00:00 2001 From: Daniel Barlow Date: Sun, 6 Mar 2022 23:05:24 +0000 Subject: [PATCH 12/27] make names more consistent --- just/just.fnl | 10 +++++----- just/viewplex.fnl | 37 ++++++++++++++++++++----------------- 2 files changed, 25 insertions(+), 22 deletions(-) diff --git a/just/just.fnl b/just/just.fnl index ce651db..e2d4d51 100644 --- a/just/just.fnl +++ b/just/just.fnl @@ -44,10 +44,10 @@ :on_clicked #(webview:refresh) }) (: :set_image (named-image "view-refresh"))) - show-tabs (Gtk.Button { - :label "><" - :on_clicked #(webview:show-pages) - }) + show-overview (Gtk.Button { + :label "><" + :on_clicked #(webview:show-overview) + }) back (doto (Gtk.Button { :on_clicked #(webview:go-back) @@ -61,7 +61,7 @@ (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) + (widget:pack_end show-overview false false 2) (webview:listen :uri #(url:set_text $1)) diff --git a/just/viewplex.fnl b/just/viewplex.fnl index 592dfb0..dab181c 100644 --- a/just/viewplex.fnl +++ b/just/viewplex.fnl @@ -73,7 +73,7 @@ :width thumbnail-width :height thumbnail-height :image-position Gtk.PositionType.TOP - :on_clicked #(self:focus w) + :on_clicked #(self:focus-view w) })] (on-swipe b #(self:remove-view w)) (webview-thumbnail-image w.widget #(b:set_image $1)) @@ -104,14 +104,18 @@ :show_tabs false }) overview (Gtk.ScrolledWindow) - overview-page (widget:append_page overview) + overview-page-num (widget:append_page overview) + relay-event (fn [source event-name] + (source:listen + event-name + #(if (= source foreground-view) + (listeners:notify event-name $1)))) views {}] { :listen (fn [_ name fun] (if (not (. relay-events name)) (each [_ v (pairs views)] - (v:listen name #(if (= v foreground-view) - (listeners:notify name $1))))) + (relay-event v name))) (table.insert relay-events name) (listeners:add name fun)) @@ -121,8 +125,7 @@ (set foreground-view webview) (webview.widget:show) (each [_ event-name (ipairs relay-events)] - (webview:listen event-name - #(listeners:notify event-name $1))) + (relay-event webview event-name)) (let [page (widget:append_page webview.widget)] (tset views page webview) (set widget.page page) @@ -132,20 +135,20 @@ (let [page (widget:page_num view.widget)] (tset views page nil) (widget:remove_page page) - (self:show-pages) + (self:show-overview) )) - :focus (fn [_ view] - (when view - (set foreground-view view) - (each [_ prop (ipairs relay-events)] - (listeners:notify prop (. view.properties prop))) - (set widget.page (widget:page_num view.widget)))) + :focus-view (fn [_ view] + (when view + (set foreground-view view) + (each [_ prop (ipairs relay-events)] + (listeners:notify prop (. view.properties prop))) + (set widget.page (widget:page_num view.widget)))) - :show-pages (fn [self] - (set foreground-view nil) - (set widget.page overview-page) - (refresh-overview self overview views)) + :show-overview (fn [self] + (set foreground-view nil) + (set widget.page overview-page-num) + (refresh-overview self overview views)) :visit #(and foreground-view (foreground-view:visit $2)) :stop-loading #(and foreground-view From 07708b47fda7c6644ebdfad4084975603687ed1c Mon Sep 17 00:00:00 2001 From: Daniel Barlow Date: Sun, 6 Mar 2022 23:11:55 +0000 Subject: [PATCH 13/27] move webview thumbnail code from viewplex to webview --- just/viewplex.fnl | 31 +------------------------------ just/webview.fnl | 32 ++++++++++++++++++++++++++++++++ 2 files changed, 33 insertions(+), 30 deletions(-) diff --git a/just/viewplex.fnl b/just/viewplex.fnl index dab181c..0ad19b3 100644 --- a/just/viewplex.fnl +++ b/just/viewplex.fnl @@ -5,35 +5,6 @@ (local thumbnail-width 300) (local thumbnail-height 200) -(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 webview-thumbnail-image [webview-widget fun] - ;; underlying call is async, so use callback - (webview-widget:get_snapshot - WebKit2.SnapshotRegion.VISIBLE - WebKit2.SnapshotOptions.NONE - nil - (fn [self res] - (let [surface (webview-widget:get_snapshot_finish res) - scaled (scale-surface surface thumbnail-width thumbnail-height) - img (doto (Gtk.Image) (: :set_from_surface scaled))] - (fun img))))) - (fn on-fake-swipe [widget fun] ;; this is here for testing on desktop systems that don't ;; have touch support @@ -76,7 +47,7 @@ :on_clicked #(self:focus-view w) })] (on-swipe b #(self:remove-view w)) - (webview-thumbnail-image w.widget #(b:set_image $1)) + (w:thumbnail-image thumbnail-width thumbnail-height #(b:set_image $1)) b) false false 5)) diff --git a/just/webview.fnl b/just/webview.fnl index 59a46a3..b138f29 100644 --- a/just/webview.fnl +++ b/just/webview.fnl @@ -2,6 +2,35 @@ (local Listeners (require :listeners)) +(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))))) + { :new @@ -24,6 +53,9 @@ :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 }) From 2e6d7fa3d2f5ce06a31c97fef24b32eb6577a0ca Mon Sep 17 00:00:00 2001 From: Daniel Barlow Date: Mon, 7 Mar 2022 09:07:41 +0000 Subject: [PATCH 14/27] set window title --- just/just.fnl | 5 ++--- 1 file changed, 2 insertions(+), 3 deletions(-) diff --git a/just/just.fnl b/just/just.fnl index e2d4d51..5cba232 100644 --- a/just/just.fnl +++ b/just/just.fnl @@ -84,6 +84,8 @@ navbar (Navbar.new viewplex) ] + (viewplex:listen :title #(window:set_title (.. $1 " - Just browsing"))) + (container:pack_start navbar.widget false false 0) (container:pack_start viewplex.widget true true 0) @@ -93,9 +95,6 @@ (viewplex:add-view v))) (window:add container) - -; (lgi.GLib.timeout_add_seconds 0 3 #(viewplex:focus one))) - (window:show_all)) (Gtk.main) From 263704ba37ecf53fb8ea091c05d9c92483c77727 Mon Sep 17 00:00:00 2001 From: Daniel Barlow Date: Mon, 7 Mar 2022 09:08:05 +0000 Subject: [PATCH 15/27] todo --- just/README.md | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/just/README.md b/just/README.md index d708d3d..87c766d 100644 --- a/just/README.md +++ b/just/README.md @@ -11,3 +11,8 @@ Touchscreen-friendly wrapper around Webkit - warning for insecure sites - try video and audio - does it save passwords? find out! where? + +--- + +to reinstate +- loading progress bar From ccdf63eea1bb855ca892a2850b5d1409cbc1d35b Mon Sep 17 00:00:00 2001 From: Daniel Barlow Date: Mon, 7 Mar 2022 09:20:14 +0000 Subject: [PATCH 16/27] add loading progress bar, hook to signals --- just/just.fnl | 21 +++++++++++++++++++++ 1 file changed, 21 insertions(+) diff --git a/just/just.fnl b/just/just.fnl index 5cba232..4fdfada 100644 --- a/just/just.fnl +++ b/just/just.fnl @@ -21,6 +21,20 @@ (.. cache-dir "/cookies.db") WebKit2.CookiePersistentStorage.SQLITE)) +(let [css " +progress, trough { + max-height: 6px; + color: #ff44bb; +} +" + style_provider (Gtk.CssProvider)] + (style_provider:load_from_data css) + (Gtk.StyleContext.add_provider_for_screen + (Gdk.Screen.get_default) + style_provider + Gtk.STYLE_PROVIDER_PRIORITY_APPLICATION + )) + (fn named-image [name size] (Gtk.Image.new_from_icon_name name @@ -82,11 +96,18 @@ }) viewplex (Viewplex.new) navbar (Navbar.new viewplex) + progress-bar (Gtk.ProgressBar { + :orientation Gtk.Orientation.HORIZONTAL + :fraction 1.0 + :margin 0 + }) ] (viewplex:listen :title #(window:set_title (.. $1 " - Just browsing"))) + (viewplex:listen :estimated-load-progress #(tset progress-bar :fraction $1)) (container:pack_start navbar.widget false false 0) + (container:pack_start progress-bar false false 0) (container:pack_start viewplex.widget true true 0) (each [_ url (ipairs arg)] From 5871afe19735a3e8e1a8c6dc2aeb0c92293aae4c Mon Sep 17 00:00:00 2001 From: Daniel Barlow Date: Mon, 7 Mar 2022 18:56:36 +0000 Subject: [PATCH 17/27] hide stop/refresh when loading is/isn't in progress --- just/just.fnl | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/just/just.fnl b/just/just.fnl index 4fdfada..cadccaa 100644 --- a/just/just.fnl +++ b/just/just.fnl @@ -78,7 +78,10 @@ progress, trough { (widget:pack_end show-overview false false 2) (webview:listen :uri #(url:set_text $1)) - + (webview:listen :estimated-load-progress + (fn [fraction] + (tset stop :visible (< fraction 1)) + (tset refresh :visible (>= fraction 1)))) { :widget widget })) From d831ccbb67e0deb049bb5f48b811529d98b71d51 Mon Sep 17 00:00:00 2001 From: Daniel Barlow Date: Wed, 9 Mar 2022 23:30:23 +0000 Subject: [PATCH 18/27] add DWIMminess to url bar text entry - prepend https:// to things that might be partial URLs - perform searches for things that are not URLs (e.g. contain spaces) - use different search engines for things that start with @foo e.g. @ebay, @ddg, @lua --- just/just.fnl | 26 +++++++++++++++++++++++++- 1 file changed, 25 insertions(+), 1 deletion(-) diff --git a/just/just.fnl b/just/just.fnl index cadccaa..4d7241f 100644 --- a/just/just.fnl +++ b/just/just.fnl @@ -40,6 +40,30 @@ progress, trough { name (or size Gtk.IconSize.LARGE_TOOLBAR))) +(fn urlencode [url] + (-> url + (: :gsub "([^%w ])" (fn [c] (string.format "%%%02X" (string.byte c)))) + (: :gsub " " "+"))) + +(print (urlencode "hello world o'hare & feirneds")) + +(local default-search-provider "ddg") + +(fn search-term-to-uri [provider text] + (match provider + "ebay" (.. "https://www.ebay.co.uk/sch/i.html?_nkw=" (urlencode text)) + "lua" (.. "https://pgl.yoyo.org/luai/i/" (urlencode text)) + "ddg" (.. "https://duckduckgo.com/?q=" (urlencode text)))) + +(fn to-uri [text] + (if (text:find " ") + (let [(_ _ provider term) (text:find "^@(%g+) *(.*)")] + (if provider + (search-term-to-uri provider term) + (search-term-to-uri default-search-provider text))) + (text:find "^http") text + (.. "https://" text))) + (local Navbar { @@ -48,7 +72,7 @@ progress, trough { (let [url (Gtk.Entry { ;; :completion (Gtk.EntryCompletion {:model completions :text_column 0 }) :on_activate - #(webview:visit $1.text) + #(webview:visit (to-uri $1.text)) }) stop (doto (Gtk.Button { :on_clicked #(webview:stop-loading) From a928c40cd0e62d6cc49089ab1ef41b4e577e26d7 Mon Sep 17 00:00:00 2001 From: Daniel Barlow Date: Wed, 9 Mar 2022 23:45:52 +0000 Subject: [PATCH 19/27] open a blank webview if no URLs on command line --- just/just.fnl | 11 +++++++---- 1 file changed, 7 insertions(+), 4 deletions(-) diff --git a/just/just.fnl b/just/just.fnl index 4d7241f..b3678c6 100644 --- a/just/just.fnl +++ b/just/just.fnl @@ -137,10 +137,13 @@ progress, trough { (container:pack_start progress-bar false false 0) (container:pack_start viewplex.widget true true 0) - (each [_ url (ipairs arg)] - (let [v (Webview.new)] - (v:visit url) - (viewplex:add-view v))) + (if (. arg 1) + (each [_ url (ipairs arg)] + (let [v (Webview.new)] + (v:visit url) + (viewplex:add-view v))) + (viewplex:add-view + (doto (Webview.new) (: :visit "about:blank")))) (window:add container) (window:show_all)) From a16d1a46e38391be03666b5db1170c27137aa39c Mon Sep 17 00:00:00 2001 From: Daniel Barlow Date: Thu, 10 Mar 2022 00:18:35 +0000 Subject: [PATCH 20/27] handle ESC in text entry to revert changes to current url --- just/README.md | 1 - just/just.fnl | 7 +++++++ just/viewplex.fnl | 4 +++- 3 files changed, 10 insertions(+), 2 deletions(-) diff --git a/just/README.md b/just/README.md index 87c766d..3a1fc32 100644 --- a/just/README.md +++ b/just/README.md @@ -7,7 +7,6 @@ Touchscreen-friendly wrapper around Webkit - downloads (pass to download manager) - find out if it's going to eat cpu like luakit does - some kind of bookmarks/favourites/pinned tabs/memory of visited sites -- ESC in url bar cancels typing - warning for insecure sites - try video and audio - does it save passwords? find out! where? diff --git a/just/just.fnl b/just/just.fnl index b3678c6..95ddff3 100644 --- a/just/just.fnl +++ b/just/just.fnl @@ -64,6 +64,10 @@ progress, trough { (text:find "^http") text (.. "https://" text))) +(local keysyms { + :Escape 0xff1b + }) + (local Navbar { @@ -73,6 +77,9 @@ progress, trough { ;; :completion (Gtk.EntryCompletion {:model completions :text_column 0 }) :on_activate #(webview:visit (to-uri $1.text)) + :on_key_release_event + #(if (= $2.keyval keysyms.Escape) + (tset $1 :text webview.properties.uri)) }) stop (doto (Gtk.Button { :on_clicked #(webview:stop-loading) diff --git a/just/viewplex.fnl b/just/viewplex.fnl index 0ad19b3..364ce12 100644 --- a/just/viewplex.fnl +++ b/just/viewplex.fnl @@ -99,6 +99,7 @@ (relay-event webview event-name)) (let [page (widget:append_page webview.widget)] (tset views page webview) + (tset self :properties webview.properties) (set widget.page page) page)) @@ -109,11 +110,12 @@ (self:show-overview) )) - :focus-view (fn [_ view] + :focus-view (fn [self view] (when view (set foreground-view view) (each [_ prop (ipairs relay-events)] (listeners:notify prop (. view.properties prop))) + (tset self :properties view.properties) (set widget.page (widget:page_num view.widget)))) :show-overview (fn [self] From 400124570db749ad9738492b59252ad245f54358 Mon Sep 17 00:00:00 2001 From: Daniel Barlow Date: Thu, 10 Mar 2022 09:37:26 +0000 Subject: [PATCH 21/27] add completions to text entry --- just/just.fnl | 13 +++++++++++-- 1 file changed, 11 insertions(+), 2 deletions(-) diff --git a/just/just.fnl b/just/just.fnl index 95ddff3..eee8bd7 100644 --- a/just/just.fnl +++ b/just/just.fnl @@ -64,6 +64,13 @@ progress, trough { (text:find "^http") text (.. "https://" text))) +(local completions + (doto (Gtk.ListStore) + (: :set_column_types [lgi.GObject.Type.STRING]))) + +(fn add-autocomplete-suggestion [url] + (completions:append [url])) + (local keysyms { :Escape 0xff1b }) @@ -74,9 +81,11 @@ progress, trough { :new (fn [webview] (let [url (Gtk.Entry { - ;; :completion (Gtk.EntryCompletion {:model completions :text_column 0 }) + :completion (Gtk.EntryCompletion {:model completions :text_column 0 }) :on_activate - #(webview:visit (to-uri $1.text)) + (fn [event] + (add-autocomplete-suggestion event.text) + (webview:visit (to-uri event.text))) :on_key_release_event #(if (= $2.keyval keysyms.Escape) (tset $1 :text webview.properties.uri)) From 75811b6d6c54600f7d65ac57d4c7fab49555001d Mon Sep 17 00:00:00 2001 From: Daniel Barlow Date: Thu, 10 Mar 2022 09:37:51 +0000 Subject: [PATCH 22/27] remove debug output --- just/just.fnl | 2 -- 1 file changed, 2 deletions(-) diff --git a/just/just.fnl b/just/just.fnl index eee8bd7..edf8e5a 100644 --- a/just/just.fnl +++ b/just/just.fnl @@ -45,8 +45,6 @@ progress, trough { (: :gsub "([^%w ])" (fn [c] (string.format "%%%02X" (string.byte c)))) (: :gsub " " "+"))) -(print (urlencode "hello world o'hare & feirneds")) - (local default-search-provider "ddg") (fn search-term-to-uri [provider text] From ad69c88486cb90a289df0581c6755b4cd0b3d5db Mon Sep 17 00:00:00 2001 From: Daniel Barlow Date: Thu, 10 Mar 2022 09:38:01 +0000 Subject: [PATCH 23/27] update TODO --- just/README.md | 9 +++------ 1 file changed, 3 insertions(+), 6 deletions(-) diff --git a/just/README.md b/just/README.md index 3a1fc32..2655c97 100644 --- a/just/README.md +++ b/just/README.md @@ -4,14 +4,11 @@ Touchscreen-friendly wrapper around Webkit ## TO DO -- downloads (pass to download manager) +- deal with unsuported mime types (pass to download manager?) - find out if it's going to eat cpu like luakit does - some kind of bookmarks/favourites/pinned tabs/memory of visited sites - warning for insecure sites - try video and audio - does it save passwords? find out! where? - ---- - -to reinstate -- loading progress bar +- better icon for overview button +- add new tab From b7956d70bb285381eac2f70bbdb5441f0185a066 Mon Sep 17 00:00:00 2001 From: Daniel Barlow Date: Thu, 10 Mar 2022 11:50:46 +0000 Subject: [PATCH 24/27] hook up the "new tab" button --- just/README.md | 1 - just/just.fnl | 3 ++- just/viewplex.fnl | 10 ++++++---- 3 files changed, 8 insertions(+), 6 deletions(-) diff --git a/just/README.md b/just/README.md index 2655c97..d7839ae 100644 --- a/just/README.md +++ b/just/README.md @@ -11,4 +11,3 @@ Touchscreen-friendly wrapper around Webkit - try video and audio - does it save passwords? find out! where? - better icon for overview button -- add new tab diff --git a/just/just.fnl b/just/just.fnl index edf8e5a..950e8ec 100644 --- a/just/just.fnl +++ b/just/just.fnl @@ -144,7 +144,8 @@ progress, trough { }) ] - (viewplex:listen :title #(window:set_title (.. $1 " - Just browsing"))) + (viewplex:listen :title #(window:set_title + (.. (or $1 "") " - Just browsing"))) (viewplex:listen :estimated-load-progress #(tset progress-bar :fraction $1)) (container:pack_start navbar.widget false false 0) diff --git a/just/viewplex.fnl b/just/viewplex.fnl index 364ce12..3d6b1c5 100644 --- a/just/viewplex.fnl +++ b/just/viewplex.fnl @@ -1,4 +1,5 @@ (local { : Gtk : Gdk : WebKit2 : cairo } (require :lgi)) +(local Webview (require :webview)) (local Listeners (require :listeners)) @@ -56,7 +57,10 @@ :label " + " :width 300 :height 200 - ; :on_clicked #(bus:publish $1 :new-tab) + :on_clicked (fn [] + (self:add-view + (doto (Webview.new) + (: :visit "about:blank")))) }) false false 5) @@ -93,14 +97,12 @@ :widget widget :add-view (fn [self webview] - (set foreground-view webview) (webview.widget:show) (each [_ event-name (ipairs relay-events)] (relay-event webview event-name)) (let [page (widget:append_page webview.widget)] (tset views page webview) - (tset self :properties webview.properties) - (set widget.page page) + (self:focus-view webview) page)) :remove-view (fn [self view] From da435b0667d670fa6febd16e06626bede1d55617 Mon Sep 17 00:00:00 2001 From: Daniel Barlow Date: Mon, 14 Mar 2022 18:41:34 +0000 Subject: [PATCH 25/27] restore adblock (rather messy) --- just/just.fnl | 7 +++-- just/viewplex.fnl | 6 ++-- just/webview.fnl | 76 ++++++++++++++++++++++++++++++++--------------- 3 files changed, 60 insertions(+), 29 deletions(-) diff --git a/just/just.fnl b/just/just.fnl index 950e8ec..86bf9ce 100644 --- a/just/just.fnl +++ b/just/just.fnl @@ -135,7 +135,7 @@ progress, trough { container (Gtk.Box { :orientation Gtk.Orientation.VERTICAL }) - viewplex (Viewplex.new) + viewplex (Viewplex.new {:content-filter-store content-filter-store}) navbar (Navbar.new viewplex) progress-bar (Gtk.ProgressBar { :orientation Gtk.Orientation.HORIZONTAL @@ -154,11 +154,12 @@ progress, trough { (if (. arg 1) (each [_ url (ipairs arg)] - (let [v (Webview.new)] + (let [v (Webview.new {:content-filter-store content-filter-store} )] (v:visit url) (viewplex:add-view v))) (viewplex:add-view - (doto (Webview.new) (: :visit "about:blank")))) + (doto (Webview.new {:content-filter-store content-filter-store}) + (: :visit "about:blank")))) (window:add container) (window:show_all)) diff --git a/just/viewplex.fnl b/just/viewplex.fnl index 3d6b1c5..b020789 100644 --- a/just/viewplex.fnl +++ b/just/viewplex.fnl @@ -59,7 +59,8 @@ :height 200 :on_clicked (fn [] (self:add-view - (doto (Webview.new) + (doto (Webview.new + {:content-filter-store self.content-filter-store}) (: :visit "about:blank")))) }) false false 5) @@ -71,7 +72,7 @@ { :new - (fn [] + (fn [{: content-filter-store}] (var foreground-view nil) (let [listeners (Listeners.new) relay-events [] @@ -87,6 +88,7 @@ (listeners:notify event-name $1)))) views {}] { + :content-filter-store content-filter-store :listen (fn [_ name fun] (if (not (. relay-events name)) (each [_ v (pairs views)] diff --git a/just/webview.fnl b/just/webview.fnl index b138f29..26815b7 100644 --- a/just/webview.fnl +++ b/just/webview.fnl @@ -1,7 +1,33 @@ -(local { : Gtk : Gdk : WebKit2 : cairo } (require :lgi)) +(local { : Gtk : Gdk : WebKit2 : cairo : GLib } (require :lgi)) (local Listeners (require :listeners)) +(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 @@ -34,29 +60,31 @@ { :new - #(let [listeners (Listeners.new) - props {} - widget (WebKit2.WebView { - :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)))) - })] - ;;(load-adblocks webview.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)) + (fn [{: content-filter-store}] + (let [listeners (Listeners.new) + props {} + widget (WebKit2.WebView { + :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)) + :thumbnail-image (fn [self width height fun] + (thumbnail-image widget width height fun)) - :properties props - :widget widget - }) + :properties props + :widget widget + })) } From aa2c23a48e848255ca9ba2e3a5aef50d2a02006b Mon Sep 17 00:00:00 2001 From: Daniel Barlow Date: Sat, 19 Mar 2022 15:51:10 +0000 Subject: [PATCH 26/27] rudimentary support for downloads --- just/webview.fnl | 38 +++++++++++++++++++++++++++++++++++++- 1 file changed, 37 insertions(+), 1 deletion(-) diff --git a/just/webview.fnl b/just/webview.fnl index 26815b7..cb140e9 100644 --- a/just/webview.fnl +++ b/just/webview.fnl @@ -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)) +;; 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")] @@ -57,6 +61,28 @@ 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 @@ -64,6 +90,16 @@ (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)) From 084c6440cd143459074c264e0d8d6d0c49028e9e Mon Sep 17 00:00:00 2001 From: Daniel Barlow Date: Sat, 19 Mar 2022 15:51:49 +0000 Subject: [PATCH 27/27] update TODO --- just/README.md | 37 ++++++++++++++++++++++++++++++------- 1 file changed, 30 insertions(+), 7 deletions(-) diff --git a/just/README.md b/just/README.md index d7839ae..2688c43 100644 --- a/just/README.md +++ b/just/README.md @@ -4,10 +4,33 @@ Touchscreen-friendly wrapper around Webkit ## TO DO -- deal with unsuported mime types (pass to download manager?) -- find out if it's going to eat cpu like luakit does -- some kind of bookmarks/favourites/pinned tabs/memory of visited sites -- warning for insecure sites -- try video and audio -- does it save passwords? find out! where? -- better icon for overview button +* functional + + - find out if it's going to eat cpu like luakit does + - some kind of bookmarks/favourites/pinned tabs/memory of visited sites + - try video and audio + - does it save passwords? find out! where? + - make adblock more effective + +* cosmetic + - swipe: animate + - better icon for overview button + - warning for insecure sites + - improve the download + +* architectural + - redesign :-) + - some affordance for customization seams (hooks or subclasses or ...) + - "download" should not be in webview.fnl + + +## Notes to self + +To get an interactive repl in running code (e.g. to inspect +values in a callback) + + +``` +(local { : repl : view } (require :fennel)) +(repl {:env {:view view :other other :vars vars :of-interest of-interest}}) +```