implement pane chooser
This commit is contained in:
parent
1ba470a631
commit
f5503c3838
@ -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)
|
||||
|
||||
@ -1 +1,3 @@
|
||||
with import <nixpkgs> {} ; callPackage ./. {}
|
||||
with import <nixpkgs> {} ;
|
||||
let just = callPackage ./. {};
|
||||
in just.overrideAttrs(o: { JUST_HACKING = 1; })
|
||||
|
||||
@ -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))
|
||||
}
|
||||
))}
|
||||
|
||||
Loading…
Reference in New Issue
Block a user