aboutsummaryrefslogtreecommitdiff
path: root/tw/services/desktop.scm
blob: 8de8231d35766dd128b804b9636dd073141d3cf4 (about) (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
(define-module (tw services desktop)
  #:use-module (gnu)
  #:use-module (gnu home services)
  #:use-module (gnu home services shepherd)
  #:use-module ((gnu packages networking) #:select (blueman))
  #:use-module ((gnu packages wm) #:select (polybar))
  #:use-module ((gnu packages xdisorg) #:select (numlockx hsetroot))
  #:use-module ((gnu packages xorg) #:select (xrandr xset))
  #:use-module (gnu services configuration)
  #:use-module (guix gexp)
  #:use-module (guix packages)
  #:use-module ((guix records) #:select (match-record))
  #:use-module (srfi srfi-1)
  #:use-module (srfi srfi-26)
  #:use-module ((tw theme) #:select (catppuccin-polybar))
  #:export (home-desktop-layout-configuration
            home-monitor-configuration
            home-desktop-layout-service-type
            home-blueman-service-type))


;; Monitor layout and polybars

(define-maybe/no-serialization string)

(define (list-of-strings? thing)
  (and (list? thing) (every string? thing)))

(define-configuration/no-serialization home-monitor-configuration
  (name string "The monitor's name in X11.")
  (xrandr-options (list-of-strings '()) "Options to pass to xrandr to
configure this monitor."))

(define (list-of-monitors? thing)
  (and (list? thing) (every home-monitor-configuration? thing)))

(define-configuration/no-serialization home-desktop-layout-configuration
  (desktop-background string "Path to an image that will be set as the desktop
background.  An initial @code{~/} is replaced with $HOME/.")
  (battery-name maybe-string "The device name of the system's battery, if any.
See @code{/sys/class/power_supply}.")
  (ac-adapter-name maybe-string "The device name of the system's mains power
supply, if any.  See @code{/sys/class/power_supply}.")
  (monitors list-of-monitors "List of monitor declarations to apply."))

(define (polybar-config monitors)
  `(("polybar/config.ini" ,(local-file "files/polybar.ini"))
    ("polybar/catppuccin.ini" ,catppuccin-polybar)))

(define polybar-wrapper
  (program-file "polybar-wrapper"
    #~(begin
        ;; This wrapper program checks that the monitor we want to start
        ;; polybar on is actually connected.
        (use-modules (ice-9 popen)
                     (ice-9 rdelim))
        (let* ((connected-str (string-append (getenv "POLYBAR_MONITOR") " connected"))
               (xrandr (open-pipe* OPEN_READ #$(file-append xrandr "/bin/xrandr") "-q"))
               (monitor-connected?
                (let loop ((line (read-line xrandr)))
                  (cond
                   ((eof-object? line) #f)                   ; we didn't find our monitor connected
                   ((string-prefix? connected-str line) #t)  ; the monitor we want is connected
                   (else (loop (read-line xrandr)))))))      ; keep looking
          (close-pipe xrandr)
          (when monitor-connected?
            (execl #$(file-append polybar "/bin/polybar")))))))

(define (maybe-value maybe fallback)
  (if (maybe-value-set? maybe) maybe fallback))

(define (polybar-service monitor battery-name ac-adapter-name)
  (shepherd-service
   (documentation (string-append "Polybar desktop bar for monitor " monitor "."))
   (provision (list (symbol-append 'polybar- (string->symbol monitor))))
   (requirement '(xorg-setup))
   (start #~(make-forkexec-constructor
             (list #$polybar-wrapper)
             #:environment-variables
             (cons* #$(string-append "POLYBAR_MONITOR=" monitor)
                    #$(string-append "POLYBAR_BATTERY=" (maybe-value battery-name ""))
                    #$(string-append "POLYBAR_AC_ADAPTER=" (maybe-value ac-adapter-name ""))
                    (default-environment-variables))))
   (stop #~(make-kill-destructor))))

(define (desktop-layout-services config)
  (match-record config <home-desktop-layout-configuration>
                (desktop-background battery-name ac-adapter-name monitors)
    (cons* (shepherd-service
            (documentation "Set up X displays on login.")
            (provision '(xorg-setup))
            (one-shot? #t)
            (start #~(lambda _
                       (define (replace-home path)
                         (if (string-prefix? "~/" path)
                             (string-replace path (getenv "HOME") 0 1)
                             path))
                       (system* #$(file-append numlockx "/bin/numlockx") "on")
                       ;; Turn off the monitors if there is no input for 10 minutes.
                       (system* #$(file-append xset "/bin/xset") "dpms" "600" "600" "600")
                       ;; TODO: may need one xrandr invocation per monitor; this is
                                        ; ;what tw/home/cern.scm had before.
                       (system* #$(file-append xrandr "/bin/xrandr")
                                #$@(append-map (lambda (monitor)
                                                 (match-record monitor <home-monitor-configuration>
                                                               (name xrandr-options)
                                                   `("--output" ,name ,@xrandr-options)))
                                               monitors))
                       ;; Set the desktop background picture. Hopefully doing this just after
                       ;; xrandr works and sets it for both screens.
                       (system* #$(file-append hsetroot "/bin/hsetroot")
                                "-cover" (replace-home #$desktop-background)))))
           (map (compose (cut polybar-service <> battery-name ac-adapter-name)
                         home-monitor-configuration-name)
                monitors))))

(define home-desktop-layout-service-type
  (service-type
   (name 'desktop-layout)
   (extensions
    (list (service-extension home-shepherd-service-type desktop-layout-services)
          (service-extension home-xdg-configuration-files-service-type polybar-config)))
   (description
    "Configure the desktop background, monitor layout and polybar.")))


;; Blueman

(define (blueman-services config)
  (list (shepherd-service
         (documentation "Blueman applet; provides a GUI for connection to bluetooth devices.")
         (provision '(blueman-applet))
         (start #~(make-forkexec-constructor
                   (list #$(file-append blueman "/bin/blueman-applet"))))
         (stop #~(make-kill-destructor)))))

(define home-blueman-service-type
  (service-type
   (name 'blueman)
   (default-value #f)
   (extensions
    (list (service-extension home-shepherd-service-type blueman-services)))
   (description
    "Run the Blueman applet for graphical Bluetooth control.")))