diff --git a/configuration.nix b/configuration.nix index 0e7cde7..5cfc4a2 100644 --- a/configuration.nix +++ b/configuration.nix @@ -13,6 +13,7 @@ let }; modemmanager_ = pkgs.callPackage ./modem-manager.nix {}; + saturn = pkgs.callPackage ./pkgs/saturn {}; drm-framebuffer = pkgs.stdenv.mkDerivation { name = "drm-framebuffer"; diff --git a/pkgs/saturn/Makefile b/pkgs/saturn/Makefile new file mode 100644 index 0000000..91a3b39 --- /dev/null +++ b/pkgs/saturn/Makefile @@ -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 diff --git a/pkgs/saturn/README.md b/pkgs/saturn/README.md new file mode 100644 index 0000000..956bc26 --- /dev/null +++ b/pkgs/saturn/README.md @@ -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 diff --git a/pkgs/saturn/default.nix b/pkgs/saturn/default.nix new file mode 100644 index 0000000..7f2d5ce --- /dev/null +++ b/pkgs/saturn/default.nix @@ -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 < $out/share/dbus-1/services/net.telent.saturn.service + [D-BUS Service] + Name=net.telent.saturn + Exec=$out/bin/saturn + SERVICE + ''; +} diff --git a/pkgs/saturn/main.fnl b/pkgs/saturn/main.fnl new file mode 100644 index 0000000..0ce3f24 --- /dev/null +++ b/pkgs/saturn/main.fnl @@ -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 + " + + + + + Switch visibility of launcher window + + + + + Toggle launcher window visible/invisible + + + + + + " + 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) diff --git a/pkgs/saturn/shell.nix b/pkgs/saturn/shell.nix new file mode 100644 index 0000000..a43de8c --- /dev/null +++ b/pkgs/saturn/shell.nix @@ -0,0 +1,7 @@ +with import { 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 ++ + [ ] ; +})