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

Merge branch 'main' of github.com:telent/slab

Browse Source
This commit is contained in:
Daniel Barlow 2022-01-30 17:20:02 +00:00
commit 83d9573917
1 changed files with 51 additions and 15 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

66
saturn/main.fnl
View File

@ -3,6 +3,8 @@
(local dbus (require :dbus_proxy))
(local inspect (require :inspect))
(local ICON_SIZE 64)
(local dbus-service-attrs
{
:bus dbus.Bus.SESSION
@ -25,13 +27,23 @@
<interface name='net.telent.saturn'>
<method name='SetVisible'>
<arg type='b' name='visible' direction='in'/>
<doc:doc><doc:description>
Switch visibility of launcher window
</doc:description></doc:doc>
</method>
<method name='ToggleVisible'>
<doc:doc><doc:description>
Toggle launcher window visible/invisible
</doc:description></doc:doc>
</method>
<property name='Visible' type='b' access='read'>
</property>
</interface>
</node>"
node-info (Gio.DBusNodeInfo.new_for_xml xml)]
(. node-info.interfaces 1)))
;; these values don't seem to be available through introspection
(local DBUS_NAME_FLAG_DO_NOT_QUEUE 4)
(local DBUS_REQUEST_NAME_REPLY_PRIMARY_OWNER 1)
(local DBUS_REQUEST_NAME_REPLY_IN_QUEUE 2)
@ -43,10 +55,13 @@
(match ret
DBUS_REQUEST_NAME_REPLY_PRIMARY_OWNER
true
DBUS_REQUEST_NAME_REPLY_ALREADY_OWNER
true
DBUS_REQUEST_NAME_REPLY_IN_QUEUE
(error "unexpected DBUS_REQUEST_NAME_REPLY_IN_QUEUE")
DBUS_REQUEST_NAME_REPLY_EXISTS
;; Show the currently running instance
(let [saturn (dbus.Proxy:new dbus-service-attrs)]
@ -59,7 +74,11 @@
(local inspect (require :inspect))
(local posix (require :posix))
(local path {
:absolute? (fn [str] (= (str:sub 1 1) "/"))
})
(local Gtk lgi.Gtk)
(local GdkPixbuf lgi.GdkPixbuf)
(local Pango lgi.Pango)
(local icon-theme (Gtk.IconTheme.get_default))
@ -72,15 +91,21 @@
}))
(fn find-icon [name]
(var found false)
(if (= (name.sub 1 1) "/")
(Gtk.Image.new_from_file name)
(let [sizes (icon-theme:get_icon_sizes name)]
(each [_ res (pairs [64 48]) :until found]
(set found (icon-theme:load_icon
name res
(+ Gtk.IconLookupFlags.FORCE_SVG Gtk.IconLookupFlags.USE_BUILTIN))))
(Gtk.Image.new_from_pixbuf found))))
(if (path.absolute? name)
;; From a direct path
(set found (GdkPixbuf.Pixbuf.new_from_file_at_size name ICON_SIZE ICON_SIZE))
;; From icon theme
(let [sizes (icon-theme:get_icon_sizes name)]
;; Uses a list of "safe fallback" values
;; Try the desired size first
(each [_ res (pairs [ICON_SIZE 128 64 48]) :until found]
(set found
(-?> (icon-theme:load_icon
name res
(+ Gtk.IconLookupFlags.FORCE_SVG Gtk.IconLookupFlags.USE_BUILTIN))
(: :scale_simple ICON_SIZE ICON_SIZE GdkPixbuf.InterpType.BILINEAR))))
))
(Gtk.Image.new_from_pixbuf found))
(fn read-desktop-file [f]
(let [parsed (inifile.parse f)
@ -135,19 +160,30 @@
(fn handle-dbus-method-call [conn sender path interface method params invocation]
(when (and (= path dbus-service-attrs.path)
(= interface dbus-service-attrs.interface))
(match method
"SetVisible"
(let [[value] (dbus.variant.strip params)]
(if value (window:show_all) (window:hide))
(invocation:return_value nil))
"ToggleVisible"
(let [v window.visible]
(if v (window:hide) (window:show_all))
(invocation:return_value nil)))))
(fn handle-dbus-get [conn sender path interface name]
(when (and (= path dbus-service-attrs.path)
(= interface dbus-service-attrs.interface)
(= method "SetVisible"))
(let [[value] (dbus.variant.strip params)]
(if value (window:show_all) (window:hide))
(invocation:return_value nil))))
(= name "Visible"))
(lgi.GLib.Variant "b" window.visible)))
(Gio.DBusConnection.register_object
bus.connection
dbus-service-attrs.path
interface-info
(lgi.GObject.Closure handle-dbus-method-call)
(lgi.GObject.Closure (fn [a] (print "get")))
(lgi.GObject.Closure handle-dbus-get)
(lgi.GObject.Closure (fn [a] (print "set"))))
(let [grid (Gtk.FlowBox {