274 lines
8.5 KiB
Fennel
274 lines
8.5 KiB
Fennel
(local lgi (require :lgi))
|
|
(local dbus (require :dbus_proxy))
|
|
(local Gio lgi.Gio)
|
|
(local GLib lgi.GLib)
|
|
(local GV lgi.GLib.Variant)
|
|
(local GtkLayerShell lgi.GtkLayerShell)
|
|
(local variant dbus.variant)
|
|
(local Gtk lgi.Gtk)
|
|
|
|
(fn relpath [filename]
|
|
(.. (os.getenv "EUFON_PATH") "/crier/" filename))
|
|
|
|
(local dbus-service-attrs
|
|
{
|
|
:bus dbus.Bus.SESSION
|
|
:name "org.freedesktop.Notifications"
|
|
:interface "org.freedesktop.Notifications"
|
|
:path "/org/freedesktop/Notifications"
|
|
})
|
|
|
|
(local bus (dbus.Proxy:new
|
|
{
|
|
:bus dbus.Bus.SESSION
|
|
:name "org.freedesktop.DBus"
|
|
:interface "org.freedesktop.DBus"
|
|
:path "/org/freedesktop/DBus"
|
|
}))
|
|
|
|
|
|
(local DBUS_NAME_FLAG_DO_NOT_QUEUE 4)
|
|
(local DBUS_REQUEST_NAME_REPLY_PRIMARY_OWNER 1)
|
|
(local DBUS_REQUEST_NAME_REPLY_IN_QUEUE 2)
|
|
(local DBUS_REQUEST_NAME_REPLY_EXISTS 3)
|
|
(local DBUS_REQUEST_NAME_REPLY_ALREADY_OWNER 4)
|
|
|
|
|
|
(let [ret (bus:RequestName dbus-service-attrs.name
|
|
DBUS_NAME_FLAG_DO_NOT_QUEUE)]
|
|
(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
|
|
(error "already running")))
|
|
|
|
(let [css (: (io.open (relpath "styles.css")) :read "*a")
|
|
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
|
|
))
|
|
|
|
;; for each open message there is a widget
|
|
;; when a message is closed, we need to find its widget
|
|
;; and remove it from the container
|
|
;; if there are no messages left, hide the windox
|
|
|
|
(fn make-window []
|
|
(let [window (Gtk.Window {:on_destroy Gtk.main_quit})
|
|
box (Gtk.Box {
|
|
:orientation Gtk.Orientation.VERTICAL
|
|
})]
|
|
(window:add box)
|
|
(when true
|
|
(GtkLayerShell.init_for_window window)
|
|
(GtkLayerShell.set_layer window GtkLayerShell.Layer.TOP)
|
|
(GtkLayerShell.auto_exclusive_zone_enable window)
|
|
|
|
(GtkLayerShell.set_margin window GtkLayerShell.Edge.TOP 1)
|
|
(GtkLayerShell.set_margin window GtkLayerShell.Edge.BOTTOM 10)
|
|
|
|
(GtkLayerShell.set_anchor window GtkLayerShell.Edge.TOP 1)
|
|
(GtkLayerShell.set_anchor window GtkLayerShell.Edge.LEFT 1)
|
|
(GtkLayerShell.set_anchor window GtkLayerShell.Edge.RIGHT 1))
|
|
(window:hide)
|
|
{:window window :box box}))
|
|
|
|
(local window (make-window))
|
|
|
|
(local notifications {})
|
|
|
|
(fn update-window []
|
|
(each [id widget (pairs notifications)]
|
|
(if (not (widget.widget:get_parent))
|
|
(window.box:pack_start widget.widget false false 5)))
|
|
(if (next notifications)
|
|
(window.window:show_all)
|
|
(window.window:hide)))
|
|
|
|
(var notification-id 10)
|
|
(fn next-notification-id []
|
|
(set notification-id (+ notification-id 1))
|
|
notification-id)
|
|
|
|
(fn delete-notification [id]
|
|
(let [widget (. notifications id)]
|
|
(if widget
|
|
(do
|
|
(tset notifications id nil)
|
|
(window.box:remove widget.widget)
|
|
(update-window)
|
|
true)
|
|
(values nil "no notification with that id"))))
|
|
|
|
|
|
(fn update-notification-widget [widget noti]
|
|
(doto widget
|
|
(: :set-summary noti.summary)
|
|
(: :set-body noti.body)
|
|
(: :set-icon noti.app-icon)
|
|
(: :set-buttons noti.actions)))
|
|
|
|
(fn emit-action [id action]
|
|
(bus.connection:emit_signal
|
|
nil ; destination
|
|
dbus-service-attrs.path
|
|
dbus-service-attrs.interface
|
|
"ActionInvoked"
|
|
(GV "(us)" [id action])))
|
|
|
|
(fn make-notification-widget [id]
|
|
(let [summary (Gtk.Label { :name "summary" })
|
|
body (Gtk.Label)
|
|
icon (Gtk.Image)
|
|
event-box (Gtk.EventBox {
|
|
:on_button_press_event #(emit-action id "default")
|
|
})
|
|
messages (Gtk.Box { :orientation Gtk.Orientation.VERTICAL})
|
|
icon-and-messages (Gtk.Box {
|
|
:name "notification"
|
|
:orientation Gtk.Orientation.HORIZONTAL
|
|
})
|
|
buttons (Gtk.Box { :orientation Gtk.Orientation.HORIZONTAL})
|
|
with-buttons (Gtk.Box { :orientation Gtk.Orientation.VERTICAL})
|
|
]
|
|
(messages:pack_start summary false false 0)
|
|
(messages:pack_start body true false 0)
|
|
(icon-and-messages:pack_start icon false false 0)
|
|
(icon-and-messages:pack_start messages true true 0)
|
|
(with-buttons:pack_start icon-and-messages false false 0)
|
|
(with-buttons:pack_start buttons false false 0)
|
|
(event-box:add with-buttons)
|
|
{
|
|
:set-summary (fn [self value]
|
|
(set summary.label value))
|
|
:set-body (fn [self value]
|
|
(set body.label value))
|
|
:set-buttons (fn [self actions]
|
|
(each [_ child (ipairs (buttons:get_children))]
|
|
(print child)
|
|
(child:destroy))
|
|
(when actions
|
|
(each [key label (pairs actions)]
|
|
(if (not (= key "default"))
|
|
(buttons:pack_start (Gtk.Button {
|
|
:on_clicked
|
|
#(emit-action id key)
|
|
:label label })
|
|
true false 0)))))
|
|
:set-icon (fn [self value]
|
|
(when value
|
|
(icon:set_from_icon_name
|
|
value
|
|
Gtk.IconSize.DND
|
|
)))
|
|
:widget event-box
|
|
}))
|
|
|
|
(fn timeout-ms [noti]
|
|
(if (or (not noti.timeout) (= noti.timeout -1))
|
|
5000
|
|
(> noti.timeout 0)
|
|
noti.timeout
|
|
(= noti.timeout 0)
|
|
nil))
|
|
|
|
(fn add-notification [noti]
|
|
(let [id (if (= noti.id 0) (next-notification-id) noti.id)
|
|
widget (or (. notifications id) (make-notification-widget id))
|
|
timeout (timeout-ms noti)]
|
|
(when timeout
|
|
(lgi.GLib.timeout_add
|
|
lgi.GLib.PRIORITY_DEFAULT timeout #(do (delete-notification id) nil)))
|
|
|
|
(update-notification-widget widget noti)
|
|
(tset notifications id widget)
|
|
(update-window)
|
|
id))
|
|
|
|
(fn parse-actions [list]
|
|
(let [out {}]
|
|
(for [i 1 (# list) 2]
|
|
(tset out (. list i) (. list (+ 1 i))))
|
|
out))
|
|
|
|
(fn make-notification [sender id icon summary body actions hints timeout]
|
|
{
|
|
:sender sender
|
|
:id id
|
|
:app-icon icon
|
|
:summary summary
|
|
:body body
|
|
:actions (parse-actions actions)
|
|
:hints hints
|
|
:timeout timeout
|
|
})
|
|
|
|
|
|
(local interface-info
|
|
(let [xml (: (io.open (relpath "interface.xml") "r") :read "*a")
|
|
node-info (Gio.DBusNodeInfo.new_for_xml xml)]
|
|
(. node-info.interfaces 1)))
|
|
|
|
(local dbus-methods
|
|
{
|
|
"GetCapabilities" #["actions" "body" "persistence"]
|
|
"GetServerInformation" #(values "crier" "telent" "0.1" "1.2")
|
|
"Notify" #(add-notification (make-notification $...))
|
|
"CloseNotification" (fn [id]
|
|
(let [(won err) (delete-notification id)]
|
|
(if won (values) (error err))))
|
|
})
|
|
|
|
(fn args-signature [args]
|
|
(var sig "")
|
|
(each [_ v (ipairs args)]
|
|
(set sig (.. sig v.signature)))
|
|
sig)
|
|
|
|
(fn handle-dbus-method-call [conn sender path interface method params invocation]
|
|
(when (and (= path dbus-service-attrs.path)
|
|
(= interface dbus-service-attrs.interface))
|
|
(let [p (dbus.variant.strip params)
|
|
info (interface-info:lookup_method method)
|
|
sig (args-signature info.out_args)]
|
|
(match (table.pack (pcall (. dbus-methods method) (table.unpack p)))
|
|
[true & vals]
|
|
(invocation:return_value (GV (.. "(" sig ")") vals))
|
|
_
|
|
(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)
|
|
(= name "Visible"))
|
|
(lgi.GLib.Variant "b" true)))
|
|
|
|
(Gio.DBusConnection.register_object
|
|
bus.connection
|
|
dbus-service-attrs.path
|
|
interface-info
|
|
(lgi.GObject.Closure handle-dbus-method-call)
|
|
(lgi.GObject.Closure handle-dbus-get)
|
|
(lgi.GObject.Closure (fn [a] (print "set"))))
|
|
|
|
|
|
(add-notification {
|
|
:app-icon "dialog-information"
|
|
:body "This is an example notifiddcation."
|
|
:id 3
|
|
:sender "notify-send"
|
|
:summary "Hello world!"
|
|
})
|
|
|
|
(Gtk:main)
|