dan
/
eufon
1
0
Fork 0
Code Issues Pull Requests Releases Activity

implement pane chooser

phoen
Daniel Barlow 2022-03-06 17:46:51 +00:00
parent 1ba470a631
commit f5503c3838
3 changed files with 157 additions and 45 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
just/just.fnl
View File

@ -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)

4
just/shell.nix
View File

@ -1 +1,3 @@
with import <nixpkgs> {} ; callPackage ./. {}
with import <nixpkgs> {} ;
let just = callPackage ./. {};
in just.overrideAttrs(o: { JUST_HACKING = 1; })

186
just/viewplex.fnl
View File

@ -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))
}
))}