add "saturn", a launcher package
This commit is contained in:
parent
0bedce6144
commit
a0e7e97a5c
@ -13,6 +13,7 @@ let
|
|||||||
};
|
};
|
||||||
|
|
||||||
modemmanager_ = pkgs.callPackage ./modem-manager.nix {};
|
modemmanager_ = pkgs.callPackage ./modem-manager.nix {};
|
||||||
|
saturn = pkgs.callPackage ./pkgs/saturn {};
|
||||||
|
|
||||||
drm-framebuffer = pkgs.stdenv.mkDerivation {
|
drm-framebuffer = pkgs.stdenv.mkDerivation {
|
||||||
name = "drm-framebuffer";
|
name = "drm-framebuffer";
|
||||||
|
|||||||
15
pkgs/saturn/Makefile
Normal file
15
pkgs/saturn/Makefile
Normal file
@ -0,0 +1,15 @@
|
|||||||
|
FENNEL?=fennel
|
||||||
|
PREFIX?=/usr/local
|
||||||
|
|
||||||
|
MODULES=main.fnl
|
||||||
|
|
||||||
|
%.lua : %.fnl
|
||||||
|
$(FENNEL) --compile $< > $@
|
||||||
|
|
||||||
|
saturn: $(patsubst %.fnl,%.lua,$(MODULES)) Makefile
|
||||||
|
(echo -e "#!/usr/bin/env lua\n" ; cat main.lua ) > $@
|
||||||
|
chmod +x $@
|
||||||
|
|
||||||
|
install:
|
||||||
|
mkdir -p $(PREFIX)/bin
|
||||||
|
cp saturn $(PREFIX)/bin
|
||||||
9
pkgs/saturn/README.md
Normal file
9
pkgs/saturn/README.md
Normal file
@ -0,0 +1,9 @@
|
|||||||
|
# Saturn
|
||||||
|
|
||||||
|
> Saturn 5, you really were the greatest sight
|
||||||
|
|
||||||
|
A very simple launcher app for the Pinephone, written using Fennel and
|
||||||
|
the LGI bindings to gobject-introspection.
|
||||||
|
|
||||||
|
I may someday separate this from the rest of Slab but for the moment
|
||||||
|
it's more convenient to keep it all together
|
||||||
99
pkgs/saturn/default.nix
Normal file
99
pkgs/saturn/default.nix
Normal file
@ -0,0 +1,99 @@
|
|||||||
|
{ stdenv
|
||||||
|
, pkg-config
|
||||||
|
, buildPackages
|
||||||
|
, callPackage
|
||||||
|
, fennel
|
||||||
|
, fetchFromGitHub
|
||||||
|
, fetchurl
|
||||||
|
, gdk-pixbuf
|
||||||
|
, glib
|
||||||
|
, gobject-introspection
|
||||||
|
, gtk3
|
||||||
|
, harfbuzz
|
||||||
|
, lib
|
||||||
|
, librsvg
|
||||||
|
, lua53Packages
|
||||||
|
, lua5_3
|
||||||
|
, makeWrapper
|
||||||
|
, pango
|
||||||
|
, wrapGAppsHook3
|
||||||
|
, writeText
|
||||||
|
}:
|
||||||
|
let
|
||||||
|
luaPackages = lua53Packages;
|
||||||
|
lgi = luaPackages.buildLuaPackage {
|
||||||
|
pname = "lgi";
|
||||||
|
version = "0.9.2-2";
|
||||||
|
buildInputs = [ gobject-introspection ];
|
||||||
|
nativeBuildInputs = [ pkg-config ];
|
||||||
|
|
||||||
|
src = fetchFromGitHub {
|
||||||
|
owner = "lgi-devs";
|
||||||
|
repo = "lgi";
|
||||||
|
rev = "e06ad94c8a1c84e3cdb80cee293450a280dfcbc7";
|
||||||
|
hash = "sha256-VYr/DV1FAyzPe6p6Quc1nmsHup23IAMfz532rL167Q4=";
|
||||||
|
};
|
||||||
|
};
|
||||||
|
luaDbusProxy = callPackage ./lua-dbus-proxy.nix {
|
||||||
|
inherit (luaPackages) buildLuaPackage;
|
||||||
|
inherit lgi;
|
||||||
|
lua = lua5_3;
|
||||||
|
};
|
||||||
|
inifile = luaPackages.buildLuaPackage rec {
|
||||||
|
pname = "inifile";
|
||||||
|
name = "${pname}-${version}";
|
||||||
|
version = "1.0.2";
|
||||||
|
src = fetchFromGitHub {
|
||||||
|
owner = "bartbes";
|
||||||
|
repo = "inifile";
|
||||||
|
rev = "f0b41a8a927f3413310510121c5767021957a4e0";
|
||||||
|
sha256 = "1ry0q238vbp8wxwy4qp1aychh687lvbckcf647pmc03rwkakxm4r";
|
||||||
|
};
|
||||||
|
buildPhase = ":";
|
||||||
|
installPhase = ''
|
||||||
|
mkdir -p "$out/share/lua/${lua.luaversion}"
|
||||||
|
cp inifile.lua "$out/share/lua/${lua.luaversion}/"
|
||||||
|
'';
|
||||||
|
};
|
||||||
|
lua = lua5_3.withPackages (ps: with ps; [
|
||||||
|
luaDbusProxy
|
||||||
|
inifile
|
||||||
|
inspect
|
||||||
|
lgi
|
||||||
|
luafilesystem
|
||||||
|
luaposix
|
||||||
|
penlight
|
||||||
|
readline
|
||||||
|
]);
|
||||||
|
in stdenv.mkDerivation {
|
||||||
|
pname = "saturn";
|
||||||
|
version = "0.4.9"; # nearly Saturn 0.5
|
||||||
|
src =./.;
|
||||||
|
|
||||||
|
buildInputs = [
|
||||||
|
lua
|
||||||
|
gtk3.dev
|
||||||
|
gobject-introspection # .dev
|
||||||
|
gdk-pixbuf
|
||||||
|
glib
|
||||||
|
];
|
||||||
|
nativeBuildInputs = [
|
||||||
|
buildPackages.lua
|
||||||
|
gobject-introspection
|
||||||
|
makeWrapper
|
||||||
|
fennel
|
||||||
|
wrapGAppsHook3
|
||||||
|
];
|
||||||
|
|
||||||
|
makeFlags = [ "PREFIX=${placeholder "out"}" ];
|
||||||
|
|
||||||
|
postInstall = ''
|
||||||
|
mkdir -p $out/share/dbus-1/services
|
||||||
|
|
||||||
|
cat <<SERVICE > $out/share/dbus-1/services/net.telent.saturn.service
|
||||||
|
[D-BUS Service]
|
||||||
|
Name=net.telent.saturn
|
||||||
|
Exec=$out/bin/saturn
|
||||||
|
SERVICE
|
||||||
|
'';
|
||||||
|
}
|
||||||
301
pkgs/saturn/main.fnl
Normal file
301
pkgs/saturn/main.fnl
Normal file
@ -0,0 +1,301 @@
|
|||||||
|
(local {: Gio
|
||||||
|
: GLib
|
||||||
|
: GObject
|
||||||
|
: Gtk
|
||||||
|
: GdkPixbuf
|
||||||
|
: Gdk
|
||||||
|
: Pango}
|
||||||
|
(require :lgi))
|
||||||
|
|
||||||
|
(local {: List
|
||||||
|
: stringx
|
||||||
|
: tablex
|
||||||
|
}
|
||||||
|
((require :pl.import_into)))
|
||||||
|
|
||||||
|
(local dbus (require :dbus_proxy))
|
||||||
|
(local inspect (require :inspect))
|
||||||
|
(local lfs (require :lfs))
|
||||||
|
(local inifile (require :inifile))
|
||||||
|
(local posix (require :posix))
|
||||||
|
|
||||||
|
(local ICON_SIZE 64)
|
||||||
|
|
||||||
|
(local CSS "
|
||||||
|
* {
|
||||||
|
color: rgb(255, 255, 255);
|
||||||
|
text-shadow:
|
||||||
|
0px 1px rgba(0, 0, 0, 255)
|
||||||
|
, 1px 0px rgba(0, 0, 0, 255)
|
||||||
|
, 0px -1px rgba(0, 0, 0, 255)
|
||||||
|
, -1px 0px rgba(0, 0, 0, 255)
|
||||||
|
, 1px 1px rgba(0, 0, 0, 255)
|
||||||
|
, 1px -1px rgba(0, 0, 0, 255)
|
||||||
|
, -1px 1px rgba(0, 0, 0, 255)
|
||||||
|
, -1px -1px rgba(0, 0, 0, 255)
|
||||||
|
;
|
||||||
|
}
|
||||||
|
button.appbutton {
|
||||||
|
padding: 0px;
|
||||||
|
}
|
||||||
|
#toplevel {
|
||||||
|
background-color: rgba(0.2, 0.2, 0.4, 1.0);
|
||||||
|
}
|
||||||
|
")
|
||||||
|
|
||||||
|
(local dbus-service-attrs
|
||||||
|
{
|
||||||
|
:bus dbus.Bus.SESSION
|
||||||
|
:name "net.telent.saturn"
|
||||||
|
:interface "net.telent.saturn"
|
||||||
|
:path "/net/telent/saturn"
|
||||||
|
})
|
||||||
|
|
||||||
|
(local bus (dbus.Proxy:new
|
||||||
|
{
|
||||||
|
:bus dbus.Bus.SESSION
|
||||||
|
:name "org.freedesktop.DBus"
|
||||||
|
:interface "org.freedesktop.DBus"
|
||||||
|
:path "/org/freedesktop/DBus"
|
||||||
|
}))
|
||||||
|
|
||||||
|
(local interface-info
|
||||||
|
(let [xml
|
||||||
|
"<node>
|
||||||
|
<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)
|
||||||
|
(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
|
||||||
|
;; Show the currently running instance
|
||||||
|
(let [saturn (dbus.Proxy:new dbus-service-attrs)]
|
||||||
|
(saturn:SetVisible true)
|
||||||
|
(os.exit 0))))
|
||||||
|
|
||||||
|
|
||||||
|
(local path {
|
||||||
|
:absolute? (fn [str] (= (str:sub 1 1) "/"))
|
||||||
|
:concat (fn [...] (table.concat [...] "/"))
|
||||||
|
})
|
||||||
|
(local search-path {
|
||||||
|
:concat (fn [...] (table.concat [...] ":"))
|
||||||
|
})
|
||||||
|
|
||||||
|
|
||||||
|
(local icon-theme (Gtk.IconTheme.get_default))
|
||||||
|
|
||||||
|
;; Use the declared CSS for this app
|
||||||
|
(let [style_provider (Gtk.CssProvider)]
|
||||||
|
(style_provider:load_from_data CSS)
|
||||||
|
(Gtk.StyleContext.add_provider_for_screen
|
||||||
|
(Gdk.Screen.get_default)
|
||||||
|
style_provider
|
||||||
|
Gtk.STYLE_PROVIDER_PRIORITY_APPLICATION
|
||||||
|
))
|
||||||
|
|
||||||
|
(local window (Gtk.Window {
|
||||||
|
:title "Saturn"
|
||||||
|
:name "toplevel"
|
||||||
|
:default_width 720
|
||||||
|
:default_height 800
|
||||||
|
:on_destroy Gtk.main_quit
|
||||||
|
}))
|
||||||
|
|
||||||
|
;; Using RGBA visual for semi-transparent backgrounds
|
||||||
|
;; Requires compositing (e.g. a compositor on X11)
|
||||||
|
(let [screen (window:get_screen)
|
||||||
|
visual (screen:get_rgba_visual)]
|
||||||
|
(window:set_visual visual))
|
||||||
|
|
||||||
|
(fn find-icon [name]
|
||||||
|
(var found false)
|
||||||
|
(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)
|
||||||
|
vals (. parsed "Desktop Entry")]
|
||||||
|
(tset vals "IconImage"
|
||||||
|
(find-icon (or vals.Icon "application-x-executable")))
|
||||||
|
(tset vals "ID" (f:sub 0 -9))
|
||||||
|
vals))
|
||||||
|
|
||||||
|
(fn current-user-home []
|
||||||
|
"Returns current user's home directory."
|
||||||
|
(-> (posix.unistd.getuid)
|
||||||
|
(posix.pwd.getpwuid)
|
||||||
|
(. :pw_dir)))
|
||||||
|
|
||||||
|
(fn xdg-data-home []
|
||||||
|
"Provides XDG_DATA_HOME or its default fallback value"
|
||||||
|
(or (os.getenv "XDG_DATA_HOME")
|
||||||
|
(path.concat (current-user-home) ".local/share/")))
|
||||||
|
|
||||||
|
(fn xdg-data-dirs []
|
||||||
|
"Provides all data-dirs as a List. Most important first."
|
||||||
|
;; Expected to be used with gmatch as a generator.
|
||||||
|
(let [dirs (List)]
|
||||||
|
(dirs:append (xdg-data-home))
|
||||||
|
(dirs:extend (stringx.split (os.getenv "XDG_DATA_DIRS") ":"))
|
||||||
|
dirs
|
||||||
|
))
|
||||||
|
|
||||||
|
(fn all-apps []
|
||||||
|
;; Each desktop entry representing an application is identified
|
||||||
|
;; by its desktop file ID, which is based on its filename.
|
||||||
|
;; — https://specifications.freedesktop.org/desktop-entry-spec/desktop-entry-spec-latest.html#desktop-file-id
|
||||||
|
"Provides apps in a List, sorted by name"
|
||||||
|
(var apps-table {})
|
||||||
|
;; Reversing the data dirs gives priority to the first elements.
|
||||||
|
;; This means conflicting `.desktop` files (or: desktop file ID) are given
|
||||||
|
;; priority to the first elements by "simply" reading it last.
|
||||||
|
(each [path (List.iter (List.reverse (xdg-data-dirs)))]
|
||||||
|
(let [apps-dir (.. path "/applications/")]
|
||||||
|
(when (lfs.attributes apps-dir)
|
||||||
|
(each [f (lfs.dir apps-dir)]
|
||||||
|
(when (= (f:sub -8) ".desktop")
|
||||||
|
(let [attrs (read-desktop-file (.. apps-dir f))]
|
||||||
|
(when (not attrs.NoDisplay)
|
||||||
|
(tset apps-table attrs.ID attrs))))))))
|
||||||
|
;; We have a table indexed by IDs, we don't care about the indexing.
|
||||||
|
;; Make a List and sort it by name.
|
||||||
|
(List.sort (List (tablex.values apps-table))
|
||||||
|
(fn [a b] (< (string.upper a.Name) (string.upper b.Name)))))
|
||||||
|
|
||||||
|
;; Exec entries in desktop files may contain %u %f and other characters
|
||||||
|
;; in which the launcher is supposed to interpolate filenames/urls etc.
|
||||||
|
;; We don't afford the user any way to pick filenames, but we do need
|
||||||
|
;; to remove the placeholders.
|
||||||
|
(fn parse-percents [str]
|
||||||
|
(str:gsub "%%(.)" (fn [c] (if (= c "%") "%" ""))))
|
||||||
|
|
||||||
|
(fn spawn-async [vec]
|
||||||
|
(let [pid (posix.unistd.fork)]
|
||||||
|
(if (> pid 0) true
|
||||||
|
(< pid 0) (assert (= "can't fork" nil))
|
||||||
|
(do
|
||||||
|
(for [f 3 255] (posix.unistd.close f))
|
||||||
|
(posix.execp "/usr/bin/env" vec)))))
|
||||||
|
|
||||||
|
(fn launch [app]
|
||||||
|
;; FIXME check app.DBusActivatable and do DBus launch if true
|
||||||
|
(let [cmd (parse-percents app.Exec)]
|
||||||
|
(if app.Terminal
|
||||||
|
(spawn-async ["kitty" cmd])
|
||||||
|
(spawn-async ["sh" "-c" cmd]))
|
||||||
|
; (window:hide)
|
||||||
|
))
|
||||||
|
|
||||||
|
(fn button-for [app]
|
||||||
|
(doto (Gtk.Button
|
||||||
|
{
|
||||||
|
:image-position Gtk.PositionType.TOP
|
||||||
|
:relief Gtk.ReliefStyle.NONE
|
||||||
|
:on_clicked #(launch app)
|
||||||
|
})
|
||||||
|
(-> (: :get_style_context) (: :add_class "appbutton"))
|
||||||
|
(: :add
|
||||||
|
(doto (Gtk.Box {:orientation Gtk.Orientation.VERTICAL})
|
||||||
|
(: :pack_start app.IconImage false false 0)
|
||||||
|
(: :pack_start
|
||||||
|
(doto
|
||||||
|
(Gtk.Label {
|
||||||
|
;; https://stackoverflow.com/questions/27462926/how-to-set-max-width-of-gtklabel-properly
|
||||||
|
:label app.Name
|
||||||
|
:justify Gtk.Justification.CENTER
|
||||||
|
:ellipsize Pango.EllipsizeMode.END
|
||||||
|
:hexpand true
|
||||||
|
})
|
||||||
|
(: :set_max_width_chars 1))
|
||||||
|
true true 0)
|
||||||
|
))))
|
||||||
|
|
||||||
|
(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)
|
||||||
|
(= name "Visible"))
|
||||||
|
(GLib.Variant "b" window.visible)))
|
||||||
|
|
||||||
|
(Gio.DBusConnection.register_object
|
||||||
|
bus.connection
|
||||||
|
dbus-service-attrs.path
|
||||||
|
interface-info
|
||||||
|
(GObject.Closure handle-dbus-method-call)
|
||||||
|
(GObject.Closure handle-dbus-get)
|
||||||
|
(GObject.Closure (fn [a] (print "set"))))
|
||||||
|
|
||||||
|
(let [grid (Gtk.FlowBox {
|
||||||
|
:orientation Gtk.Orientation.HORIZONTAL
|
||||||
|
:valign Gtk.Align.START
|
||||||
|
:column_spacing 2
|
||||||
|
:row_spacing 5
|
||||||
|
:homogeneous true
|
||||||
|
})
|
||||||
|
scrolled-window (Gtk.ScrolledWindow {})]
|
||||||
|
(each [app (List.iter (all-apps))]
|
||||||
|
(grid:insert (button-for app) -1))
|
||||||
|
(scrolled-window:add grid)
|
||||||
|
(window:add scrolled-window))
|
||||||
|
|
||||||
|
(window:show_all)
|
||||||
|
(Gtk:main)
|
||||||
7
pkgs/saturn/shell.nix
Normal file
7
pkgs/saturn/shell.nix
Normal file
@ -0,0 +1,7 @@
|
|||||||
|
with import <nixpkgs> { overlays = [ (import ../../overlay.nix) ]; } ;
|
||||||
|
(callPackage ./. {
|
||||||
|
}).overrideAttrs(o: {
|
||||||
|
GDK_PIXBUF_MODULE_FILE = "${pkgs.librsvg.out}/lib/gdk-pixbuf-2.0/2.10.0/loaders.cache";
|
||||||
|
nativeBuildInputs = o.nativeBuildInputs ++
|
||||||
|
[ ] ;
|
||||||
|
})
|
||||||
Loading…
Reference in New Issue
Block a user