commit f5503c38389eddda46eb85a6710947888671a428
parent 1ba470a63113adc4e72fd550ac9e6a4145ea5a59
Author: Daniel Barlow <dan@telent.net>
Date: Sun, 6 Mar 2022 17:46:51 +0000
implement pane chooser
Diffstat:
3 files changed, 161 insertions(+), 49 deletions(-)
diff --git 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
@@ -1 +1,3 @@
-with import <nixpkgs> {} ; callPackage ./. {}
+with import <nixpkgs> {} ;
+let just = callPackage ./. {};
+in just.overrideAttrs(o: { JUST_HACKING = 1; })
diff --git 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))
-
- :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))
-
- :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))
- :refresh #(and foreground-view (foreground-view:refresh))
- :go-back #(and foreground-view (foreground-view:go-back))
- }
- )}
+ (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
+
+ :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))
+
+ :remove-view (fn [self view]
+ (let [page (widget:page_num view.widget)]
+ (tset views page nil)
+ (widget:remove_page page)
+ (self:show-pages)
+ ))
+
+ :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))
+ }
+ ))}
