add "saturn", a launcher package

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";

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

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

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 <<SERVICE > $out/share/dbus-1/services/net.telent.saturn.service
+    [D-BUS Service]
+    Name=net.telent.saturn
+    Exec=$out/bin/saturn
+    SERVICE
+  '';
+}

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
+             "<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)

pkgs/saturn/shell.nix

@@ -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 ++
+                      [  ] ;
+})