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