init.fnl (9857B)
1 (local {: Gio 2 : GLib 3 : GObject 4 : Gtk 5 : GdkPixbuf 6 : Gdk 7 : Pango} 8 (require :lgi)) 9 10 (local {: List 11 : stringx 12 : tablex 13 } 14 ((require :pl.import_into))) 15 16 (local dbus (require :dbus_proxy)) 17 (local lfs (require :lfs)) 18 (local inifile (require :inifile)) 19 (local posix (require :posix)) 20 21 (local ICON_SIZE 64) 22 (local CSS " 23 * { 24 color: rgb(255, 255, 255); 25 text-shadow: 26 0px 1px rgba(0, 0, 0, 255) 27 , 1px 0px rgba(0, 0, 0, 255) 28 , 0px -1px rgba(0, 0, 0, 255) 29 , -1px 0px rgba(0, 0, 0, 255) 30 , 1px 1px rgba(0, 0, 0, 255) 31 , 1px -1px rgba(0, 0, 0, 255) 32 , -1px 1px rgba(0, 0, 0, 255) 33 , -1px -1px rgba(0, 0, 0, 255) 34 ; 35 } 36 button.appbutton { 37 padding: 0px; 38 } 39 #toplevel { 40 background-color: rgba(0, 0, 0, 0.6); 41 } 42 ") 43 44 (local dbus-service-attrs 45 { 46 :bus dbus.Bus.SESSION 47 :name "net.telent.saturn" 48 :interface "net.telent.saturn" 49 :path "/net/telent/saturn" 50 }) 51 52 (local bus (dbus.Proxy:new 53 { 54 :bus dbus.Bus.SESSION 55 :name "org.freedesktop.DBus" 56 :interface "org.freedesktop.DBus" 57 :path "/org/freedesktop/DBus" 58 })) 59 60 (local interface-info 61 (let [xml 62 "<node> 63 <interface name='net.telent.saturn'> 64 <method name='SetVisible'> 65 <arg type='b' name='visible' direction='in'/> 66 <doc:doc><doc:description> 67 Switch visibility of launcher window 68 </doc:description></doc:doc> 69 </method> 70 <method name='ToggleVisible'> 71 <doc:doc><doc:description> 72 Toggle launcher window visible/invisible 73 </doc:description></doc:doc> 74 </method> 75 <property name='Visible' type='b' access='read'> 76 </property> 77 </interface> 78 </node>" 79 node-info (Gio.DBusNodeInfo.new_for_xml xml)] 80 (. node-info.interfaces 1))) 81 82 ;; these values don't seem to be available through introspection 83 (local DBUS_NAME_FLAG_DO_NOT_QUEUE 4) 84 (local DBUS_REQUEST_NAME_REPLY_PRIMARY_OWNER 1) 85 (local DBUS_REQUEST_NAME_REPLY_IN_QUEUE 2) 86 (local DBUS_REQUEST_NAME_REPLY_EXISTS 3) 87 (local DBUS_REQUEST_NAME_REPLY_ALREADY_OWNER 4) 88 89 (let [ret (bus:RequestName dbus-service-attrs.name 90 DBUS_NAME_FLAG_DO_NOT_QUEUE)] 91 (match ret 92 DBUS_REQUEST_NAME_REPLY_PRIMARY_OWNER 93 true 94 95 DBUS_REQUEST_NAME_REPLY_ALREADY_OWNER 96 true 97 98 DBUS_REQUEST_NAME_REPLY_IN_QUEUE 99 (error "unexpected DBUS_REQUEST_NAME_REPLY_IN_QUEUE") 100 101 DBUS_REQUEST_NAME_REPLY_EXISTS 102 ;; Show the currently running instance 103 (let [saturn (dbus.Proxy:new dbus-service-attrs)] 104 (saturn:SetVisible true) 105 (os.exit 0)))) 106 107 108 (local path { 109 :absolute? (fn [str] (= (str:sub 1 1) "/")) 110 :concat (fn [...] (table.concat [...] "/")) 111 }) 112 (local search-path { 113 :concat (fn [...] (table.concat [...] ":")) 114 }) 115 116 (local icon-theme (Gtk.IconTheme.get_default)) 117 118 ;; Use the declared CSS for this app 119 (let [style_provider (Gtk.CssProvider)] 120 (style_provider:load_from_data CSS) 121 (Gtk.StyleContext.add_provider_for_screen 122 (Gdk.Screen.get_default) 123 style_provider 124 Gtk.STYLE_PROVIDER_PRIORITY_APPLICATION 125 )) 126 127 (local window (Gtk.Window { 128 :title "Saturn V" 129 :name "toplevel" 130 :default_width 720 131 :default_height 800 132 :on_destroy Gtk.main_quit 133 })) 134 135 ;; Using RGBA visual for semi-transparent backgrounds 136 ;; Requires compositing (e.g. a compositor on X11) 137 (let [screen (window:get_screen) 138 visual (screen:get_rgba_visual)] 139 (window:set_visual visual)) 140 141 (fn find-icon [name] 142 (var found false) 143 (if (path.absolute? name) 144 ;; From a direct path 145 (set found (GdkPixbuf.Pixbuf.new_from_file_at_size name ICON_SIZE ICON_SIZE)) 146 ;; From icon theme 147 (let [sizes (icon-theme:get_icon_sizes name)] 148 ;; Uses a list of "safe fallback" values 149 ;; Try the desired size first 150 (each [_ res (pairs [ICON_SIZE 128 64 48]) :until found] 151 (set found 152 (-?> (icon-theme:load_icon 153 name res 154 (+ Gtk.IconLookupFlags.FORCE_SVG Gtk.IconLookupFlags.USE_BUILTIN)) 155 (: :scale_simple ICON_SIZE ICON_SIZE GdkPixbuf.InterpType.BILINEAR)))) 156 )) 157 (Gtk.Image.new_from_pixbuf found)) 158 159 (fn read-desktop-file [f] 160 (let [parsed (inifile.parse f) 161 vals (. parsed "Desktop Entry")] 162 (tset vals "IconImage" 163 (find-icon (or vals.Icon "application-x-executable"))) 164 (tset vals "ID" (f:sub 0 -9)) 165 vals)) 166 167 (fn current-user-home [] 168 "Returns current user's home directory." 169 (-> (posix.unistd.getuid) 170 (posix.pwd.getpwuid) 171 (. :pw_dir))) 172 173 (fn xdg-data-home [] 174 "Provides XDG_DATA_HOME or its default fallback value" 175 (or (os.getenv "XDG_DATA_HOME") 176 (path.concat (current-user-home) ".local/share/"))) 177 178 (fn xdg-data-dirs [] 179 "Provides all data-dirs as a List. Most important first." 180 ;; Expected to be used with gmatch as a generator. 181 (let [dirs (List)] 182 (dirs:append (xdg-data-home)) 183 (dirs:extend (stringx.split (os.getenv "XDG_DATA_DIRS") ":")) 184 dirs 185 )) 186 187 (fn all-apps [] 188 ;; Each desktop entry representing an application is identified 189 ;; by its desktop file ID, which is based on its filename. 190 ;; — https://specifications.freedesktop.org/desktop-entry-spec/desktop-entry-spec-latest.html#desktop-file-id 191 "Provides apps in a List, sorted by name" 192 (var apps-table {}) 193 ;; Reversing the data dirs gives priority to the first elements. 194 ;; This means conflicting `.desktop` files (or: desktop file ID) are given 195 ;; priority to the first elements by "simply" reading it last. 196 (each [path (List.iter (List.reverse (xdg-data-dirs)))] 197 (let [apps-dir (.. path "/applications/")] 198 (when (lfs.attributes apps-dir) 199 (each [f (lfs.dir apps-dir)] 200 (when (= (f:sub -8) ".desktop") 201 (let [attrs (read-desktop-file (.. apps-dir f))] 202 (when (not attrs.NoDisplay) 203 (tset apps-table attrs.ID attrs)))))))) 204 ;; We have a table indexed by IDs, we don't care about the indexing. 205 ;; Make a List and sort it by name. 206 (List.sort (List (tablex.values apps-table)) 207 (fn [a b] (< (string.upper a.Name) (string.upper b.Name))))) 208 209 ;; Exec entries in desktop files may contain %u %f and other characters 210 ;; in which the launcher is supposed to interpolate filenames/urls etc. 211 ;; We don't afford the user any way to pick filenames, but we do need 212 ;; to remove the placeholders. 213 (fn parse-percents [str] 214 (str:gsub "%%(.)" (fn [c] (if (= c "%") "%" "")))) 215 216 (fn spawn-async [vec] 217 (let [pid (posix.unistd.fork)] 218 (if (> pid 0) true 219 (< pid 0) (assert (= "can't fork" nil)) 220 (do 221 (for [f 3 255] (posix.unistd.close f)) 222 (posix.execp "/usr/bin/env" vec))))) 223 224 (fn launch [app] 225 ;; FIXME check app.DBusActivatable and do DBus launch if true 226 (let [cmd (parse-percents app.Exec)] 227 (if app.Terminal 228 (spawn-async ["kitty" cmd]) 229 (spawn-async ["sh" "-c" cmd])) 230 (window:hide))) 231 232 (fn button-for [app] 233 (doto (Gtk.Button 234 { 235 :image-position Gtk.PositionType.TOP 236 :relief Gtk.ReliefStyle.NONE 237 :on_clicked #(launch app) 238 }) 239 (-> (: :get_style_context) (: :add_class "appbutton")) 240 (: :add 241 (doto (Gtk.Box {:orientation Gtk.Orientation.VERTICAL}) 242 (: :pack_start app.IconImage false false 0) 243 (: :pack_start 244 (doto 245 (Gtk.Label { 246 ;; https://stackoverflow.com/questions/27462926/how-to-set-max-width-of-gtklabel-properly 247 :label app.Name 248 :justify Gtk.Justification.CENTER 249 :ellipsize Pango.EllipsizeMode.END 250 :hexpand true 251 }) 252 (: :set_max_width_chars 1)) 253 true true 0) 254 )))) 255 256 (fn handle-dbus-method-call [conn sender path interface method params invocation] 257 (when (and (= path dbus-service-attrs.path) 258 (= interface dbus-service-attrs.interface)) 259 (match method 260 "SetVisible" 261 (let [[value] (dbus.variant.strip params)] 262 (if value (window:show_all) (window:hide)) 263 (invocation:return_value nil)) 264 "ToggleVisible" 265 (let [v window.visible] 266 (if v (window:hide) (window:show_all)) 267 (invocation:return_value nil))))) 268 269 (fn handle-dbus-get [conn sender path interface name] 270 (when (and (= path dbus-service-attrs.path) 271 (= interface dbus-service-attrs.interface) 272 (= name "Visible")) 273 (GLib.Variant "b" window.visible))) 274 275 (Gio.DBusConnection.register_object 276 bus.connection 277 dbus-service-attrs.path 278 interface-info 279 (GObject.Closure handle-dbus-method-call) 280 (GObject.Closure handle-dbus-get) 281 (GObject.Closure (fn [a] (print "set")))) 282 283 (let [grid (Gtk.FlowBox { 284 :orientation Gtk.Orientation.HORIZONTAL 285 :valign Gtk.Align.START 286 :column_spacing 2 287 :row_spacing 5 288 :homogeneous true 289 }) 290 scrolled-window (Gtk.ScrolledWindow {})] 291 (each [app (List.iter (all-apps))] 292 (grid:insert (button-for app) -1)) 293 (scrolled-window:add grid) 294 (window:add scrolled-window)) 295 296 (window:show_all) 297 (Gtk:main)