From 7b43961ad7c168557b3c35d00090de0cde564eeb Mon Sep 17 00:00:00 2001 From: Rutherther Date: Sat, 17 Aug 2024 21:40:20 +0200 Subject: [PATCH] feat: add start dwl guile script --- home/home-configuration.scm | 10 +- home/modules/ruther/home/dwl/scripts.scm | 232 +++++++++++++++++++++++ 2 files changed, 239 insertions(+), 3 deletions(-) create mode 100644 home/modules/ruther/home/dwl/scripts.scm diff --git a/home/home-configuration.scm b/home/home-configuration.scm index 3234caa..beaf419 100644 --- a/home/home-configuration.scm +++ b/home/home-configuration.scm @@ -19,6 +19,7 @@ (gnu home services xdg) (gnu home services) (ruther home dwl wm) + (ruther home dwl scripts) (ruther home themes) (ruther home services gtk)) @@ -118,9 +119,8 @@ (".config/waybar/style.css" ,(local-file "dotfiles/waybar/style.css")) (".config/mako/config" ,(local-file "dotfiles/mako")) - ;; Temporary until I figure out how to write those in Guile, - ;; and put services into shepherd ones - (".sessions" ,(local-file "dotfiles/session-scripts" #:recursive? #t)) + ;; TODO the services should be started by shepherd + (".start-dwl" ,(start-dwl #:dwl dwl-mine #:waybar waybar-mine)) (".config/dwl/scripts/print.sh" ,(local-file "dotfiles/dwl/print.sh")) @@ -195,3 +195,7 @@ (file-append pinentry-gtk2 "/bin/pinentry-gtk-2")))) (service home-pipewire-service-type) (service home-dbus-service-type)))) + +;; dwl package the scripts for starting, make them in Guile + +;; xdg desktop portal, wlr diff --git a/home/modules/ruther/home/dwl/scripts.scm b/home/modules/ruther/home/dwl/scripts.scm new file mode 100644 index 0000000..276fb37 --- /dev/null +++ b/home/modules/ruther/home/dwl/scripts.scm @@ -0,0 +1,232 @@ +(define-module (ruther home dwl scripts) + #:use-module (guix gexp) + #:use-module (guix records) + #:use-module (guix packages) + #:use-module (ruther packages wayland) + #:use-module (gnu packages glib) + #:use-module (gnu packages wm) + #:use-module (gnu packages emacs) + #:use-module (gnu packages networking) + #:use-module (gnu packages gnome) + #:use-module (gnu packages freedesktop) + + #:export + (wlr-output + wlr-randr-config + swayidle-timeout + swayidle-config + + start-dwl)) + +(define-record-type* + wlr-output make-wlr-output + wlr-output? + (name wlr-output-name) + (position wlr-output-position + (default #f)) + (enable? wlr-output-enable? + (default #t))) + +(define-record-type* + wlr-randr-config make-wlr-randr-config + wlr-randr-config? + (outputs wlr-randr-config-outputs)) + +(define-record-type* + swayidle-timeout make-swayidle-timeout + swayidle-timeout? + (time swayidle-timeout-time) + (command swayidle-timeout-command) + (resume swayidle-timeout-resume + (default #f))) + +(define-record-type* + swayidle-config swaidle-config + swayidle-config? + (wait? swayidle-config-wait? + (default #f)) + (lock swayidle-config-lock) + (before-sleep swayidle-config-before-sleep) + (timeouts swayidle-config-timeouts)) + +(define-public (build-wlr-randr-args config) + (let ((outputs (wlr-randr-config-outputs config))) + (apply append + (map + (lambda (output) + (append + `("--output" + ,(wlr-output-name output) + ,(if (wlr-output-enable? output) + "--on" + "--off") + ) + (if (wlr-output-position output) + `("--pos" + ,(format #f + "~a,~a" + (car (wlr-output-position output)) + (cdr (wlr-output-position output)))) + '()))) + outputs)))) + +(define-public (invoke-wlr-randr config) + #~(apply + invoke + (cons* (string-append #$wlr-randr "/bin/wlr-randr") + '#$(build-wlr-randr-args config)))) + +(define-public (build-swayidle-timeout-args timeout) + (cons* "timeout" + (format #f "~a" (swayidle-timeout-time timeout)) + (swayidle-timeout-command timeout) + (if (swayidle-timeout-resume timeout) + `("resume" + ,(swayidle-timeout-resume timeout)) + '()))) + +(define-public (build-swayidle-args config) + (let* ((mapped `((,swayidle-config-wait? . '("-w")) + (,swayidle-config-before-sleep . ("before-sleep" ,(swayidle-config-before-sleep config))) + (,swayidle-config-lock . ("lock" ,(swayidle-config-lock config))) + (,swayidle-config-timeouts . ,(apply append (map build-swayidle-timeout-args (swayidle-config-timeouts config)))))) + (filtered (filter (lambda (x) (not (nil? ((car x) config)))) + mapped))) + (apply append (map cdr filtered)))) + +(define-public (invoke-swayidle config) + #~(apply + invoke + (cons* (string-append #$swayidle "/bin/swayidle") + '#$(build-swayidle-args config)))) + +(define wlopm-all-screens-gexp + #~(begin + (use-modules + (guix build utils) + (ice-9 rdelim) + (ice-9 popen)) + + (define operation + (car (cdr (program-arguments)))) + + (define (first-word str) + (car (string-split str #\space))) + + (let* ((wlopm (string-append #$wlopm "/bin/wlopm")) + (port (open-input-pipe wlopm)) + (outputs (map first-word (string-split (string-trim-both (read-string port)) #\newline)))) + (close-pipe port) + (for-each (lambda (output) + (invoke wlopm (string-append "--" operation) output)) + outputs)))) + +(define wlopm-all-screens-bin-gexp + (with-imported-modules '((guix build utils)) + #~(begin + (use-modules (guix build utils)) + (mkdir-p (string-append #$output "/bin")) + (symlink + #$(program-file "wlopm-all-screens" wlopm-all-screens-gexp) + (string-append #$output "/bin/wlopm-all-screens"))))) + +;; Rules + +(define-public preferred-output-config + (wlr-randr-config + (outputs + (list + (wlr-output + (name "DP-9") + (position '(0 . 0)) + (enable? #t)) + (wlr-output + (name "DP-8") + (position '(3840 . 0)) + (enable? #t)) + (wlr-output + (name "DP-7") + (position '(1920 . 0)) + (enable? #t)) + (wlr-output + (name "eDP-1") + (enable? #f)))))) + +(define-public fallback-output-config + (wlr-randr-config + (outputs + (list + (wlr-output + (name "eDP-1") + (enable? #t)))))) + +(define-public idle-rules + (swayidle-config + (wait? #f) + + (lock "swayidle -Ff") + (before-sleep "swayidle -Ff") + + (timeouts + (list + (swayidle-timeout + (time 30) + (command "makoctl mode -a idle") + (resume "makoctl mode -r idle")) + (swayidle-timeout + (time 300) + (command "wlopm-all-screens off") + (resume "wlopm-all-screens on")) + (swayidle-timeout + (time 1800) + (command "loginctl suspend")))))) + +(define (dwl-startup-cmd-gexp waybar) + #~(begin + (use-modules (guix build utils) + (srfi srfi-34)) + + (spawn (string-append #$dbus "/bin/dbus-update-activation-environment") + '("dbus-update-activation-environment" + "WAYLAND_DISPLAY" + "XDG_CURRENT_DESKTOP" + "DISPLAY")) + (spawn (string-append #$network-manager-applet "/bin/nm-applet") '("nm-applet")) + (spawn (string-append #$blueman "/bin/blueman-applet") '("blueman-applet")) + (spawn (string-append #$emacs-pgtk "/bin/emacs") '("emacs" "--daemon")) + (spawn (string-append #$waybar "/bin/waybar") '("waybar")) + (guard (c ((invoke-error? c) + #$(invoke-wlr-randr fallback-output-config))) + #$(invoke-wlr-randr preferred-output-config)) + + ;; TODO: how would I go about putting the correct paths inside of idle-rules withou env? + (set-path-environment-variable + "PATH" + (map (lambda (x) (string-append x "/bin")) + '#$(list swayidle + (computed-file "wlopm-all-screens" wlopm-all-screens-bin-gexp) + mako + elogind)) + #$(invoke-swayidle idle-rules)))) + +(define (start-dwl-gexp dwl waybar) + #~(begin + (use-modules (guix build utils)) + (setenv "XDG_CURRENT_DESKTOP" "wlroots") + (setenv "XDG_BACKEND" "wayland") + (setenv "QT_QPA_PLATFORM" "wayland;xcb") + (setenv "MOZ_ENABLE_WAYLAND" "1") + (setenv "_JAVA_AWT_WM_NONREPARENTING" "1") + + (execl (string-append #$dwl "/bin/dwl") + "dwl" + "-s" #$(program-file "dwl-startup-cmd" (dwl-startup-cmd-gexp waybar))))) + +(define* (start-dwl #:key (dwl dwl-0.7) (waybar waybar)) + (program-file "start-dwl" (start-dwl-gexp dwl waybar))) + +(define-public wlopm-all-screens + (program-file "wlopm-all-screens" wlopm-all-screens-gexp)) + +(define-public wlopm-all-screens-bin + (computed-file "wlopm-all-screens" wlopm-all-screens-bin-gexp)) -- 2.48.1