projects/guix·blob python-team · refs

608 lines · 21.4 KiB

1;;; GNU Guix --- Functional package management for GNU
2;;; Copyright © 2022-2023, 2025 Ludovic Courtès <[email protected]>
3;;; Copyright © 2022 ( <[email protected]>
4;;; Copyright © 2023 conses <[email protected]>
5;;; Copyright © 2023 Janneke Nieuwenhuizen <[email protected]>
6;;; Copyright © 2025 dan <[email protected]>
7;;;
8;;; This file is part of GNU Guix.
9;;;
10;;; GNU Guix is free software; you can redistribute it and/or modify it
11;;; under the terms of the GNU General Public License as published by
12;;; the Free Software Foundation; either version 3 of the License, or (at
13;;; your option) any later version.
14;;;
15;;; GNU Guix is distributed in the hope that it will be useful, but
16;;; WITHOUT ANY WARRANTY; without even the implied warranty of
17;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18;;; GNU General Public License for more details.
19;;;
20;;; You should have received a copy of the GNU General Public License
21;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
22
23(define-module (gnu home services desktop)
24 #:use-module (gnu home services)
25 #:use-module (gnu home services shepherd)
26 #:use-module (gnu services configuration)
27 #:use-module (gnu services xorg)
28 #:autoload (gnu packages glib) (dbus)
29 #:autoload (gnu packages xdisorg) (darkman redshift unclutter)
30 #:autoload (gnu packages xorg) (setxkbmap xmodmap)
31 #:use-module (guix records)
32 #:use-module (guix gexp)
33 #:use-module (srfi srfi-1)
34 #:use-module (ice-9 match)
35 #:export (home-x11-service-type
36
37 home-wayland-service-type
38
39 home-redshift-configuration
40 home-redshift-configuration?
41 home-redshift-service-type
42
43 home-dbus-configuration
44 home-dbus-service-type
45
46 home-unclutter-configuration
47 home-unclutter-service-type
48
49 home-xmodmap-configuration
50 home-xmodmap-service-type
51
52 home-startx-command-service-type
53
54 home-darkman-configuration
55 home-darkman-configuration?
56 home-darkman-service-type))
57
58
59;;;
60;;; Waiting for X11.
61;;;
62
63(define (x11-shepherd-service delay)
64 (list (shepherd-service
65 (provision '(x11-display))
66 (modules '((ice-9 ftw)
67 (ice-9 match)
68 (srfi srfi-1)))
69 (start
70 #~(lambda* (#:optional (display (getenv "DISPLAY")))
71 (define x11-directory
72 "/tmp/.X11-unix")
73
74 (define (find-display delay)
75 ;; Wait for an accessible socket to show up in X11-DIRECTORY,
76 ;; up to DELAY seconds.
77 (let loop ((attempts delay))
78 (define socket
79 (find (match-lambda
80 ((or "." "..") #f)
81 (name
82 (let ((name (in-vicinity x11-directory
83 name)))
84 (access? name O_RDWR))))
85 (or (scandir x11-directory) '())))
86
87 (if (and socket (string-prefix? "X" socket))
88 (let ((display (string-append
89 ":" (string-drop socket 1))))
90 (format #t "X11 display server found at ~s.~%"
91 display)
92 display)
93 (if (zero? attempts)
94 (begin
95 (format (current-error-port)
96 "X11 display server did not show up; \
97giving up.\n")
98 #f)
99 (begin
100 (sleep 1)
101 (loop (- attempts 1)))))))
102
103 (let ((display (or display (find-display #$delay))))
104 (when display
105 ;; Note: 'make-forkexec-constructor' calls take their
106 ;; default #:environment-variables value before this service
107 ;; is started and are thus unaffected by the 'setenv' call
108 ;; below. Users of this service have to explicitly query
109 ;; its value.
110 (setenv "DISPLAY" display))
111 display)))
112 (stop #~(lambda (_)
113 (unsetenv "DISPLAY")
114 #f))
115 (respawn? #f))))
116
117(define home-x11-service-type
118 (service-type
119 (name 'home-x11-display)
120 (extensions (list (service-extension home-shepherd-service-type
121 x11-shepherd-service)))
122 (default-value 10)
123 (description
124 "Create a @code{x11-display} Shepherd service that waits for the X
125Window (or ``X11'') graphical display server to be up and running, up to a
126configurable delay, and sets the @code{DISPLAY} environment variable of
127@command{shepherd} itself accordingly. If no accessible X11 server shows up
128during that time, the @code{x11-display} service is marked as failing to
129start.")))
130
131
132;;;
133;;; Waiting for Wayland.
134;;;
135
136(define (wayland-shepherd-service delay)
137 (list (shepherd-service
138 (provision '(wayland-display))
139 (modules '((ice-9 ftw)
140 (ice-9 regex)
141 (ice-9 match)
142 (srfi srfi-1)
143 (shepherd support)))
144 (start
145 #~(lambda* (#:optional display (getenv "WAYLAND_DISPLAY"))
146 (define (find-socket directory regex)
147 (find (match-lambda
148 ((or "." "..") #f)
149 (name
150 (let ((name (in-vicinity directory name)))
151 (and (string-match regex name)
152 (access? name O_RDWR)))))
153 ;; Wayland names its sockets 'wayland-n'. With
154 ;; 'reverse', we pick up on the last Wayland instance
155 ;; created (essentially what we always want to do).
156 (or (reverse (scandir directory)) '())))
157
158 (define (find-display delay)
159 (let loop ((attempts delay))
160 (let ((display (find-socket %user-runtime-dir "wayland-[0-9]+$")))
161 (cond (display)
162 ((positive? attempts)
163 (sleep 1)
164 (loop (- attempts 1)))
165 (else
166 (format (current-error-port) "Wayland server did not show up; giving up.")
167 #f)))))
168
169 (let ((display (or display (find-display #$delay))))
170 (when display
171 ;; See the note on 'x11-shepherd-service'.
172 (setenv "WAYLAND_DISPLAY" display))
173 display)))
174
175 (stop #~(lambda (_)
176 (unsetenv "WAYLAND_DISPLAY")
177 #f))
178 (respawn? #f))))
179
180(define home-wayland-service-type
181 (service-type
182 (name 'home-wayland-display)
183 (extensions (list (service-extension home-shepherd-service-type
184 wayland-shepherd-service)))
185 (default-value 10)
186 (description
187 "Create a @code{wayland-display} Shepherd service that waits for a Wayland
188compositor to be up and running, up to a configurable delay, and sets the
189@code{WAYLAND_DISPLAY} environment variable of @command{shepherd} itself
190accordingly. If no accessible Wayland server shows up during that time, the
191@code{wayland-display} service is marked as failing to start.")))
192
193
194;;;
195;;; Redshift.
196;;;
197
198(define (serialize-integer field value)
199 (string-append (match field
200 ('daytime-temperature "temp-day")
201 ('nighttime-temperature "temp-night")
202 ('daytime-brightness "brightness-day")
203 ('nighttime-brightness "brightness-night")
204 ('latitude "lat")
205 ('longitude "lon")
206 (_ (symbol->string field)))
207 "=" (number->string value) "\n"))
208
209(define (serialize-symbol field value)
210 (string-append (symbol->string field)
211 "=" (symbol->string value) "\n"))
212
213(define (serialize-string field value)
214 (string-append (symbol->string field)
215 "=" value "\n"))
216
217(define serialize-inexact-number serialize-integer)
218
219(define (inexact-number? n)
220 (and (number? n) (inexact? n)))
221(define-maybe inexact-number)
222(define-maybe string)
223
224(define (serialize-raw-configuration-string field value)
225 value)
226(define raw-configuration-string? string?)
227
228(define-configuration home-redshift-configuration
229 (redshift
230 (file-like redshift)
231 "Redshift package to use.")
232
233 (location-provider
234 (symbol 'geoclue2)
235 "Geolocation provider---@code{'manual} or @code{'geoclue2}.
236
237In the former case, you must also specify the @code{latitude} and
238@code{longitude} fields so Redshift can determine daytime at your place. In
239the latter case, the Geoclue system service must be running; it will be
240queried for location information.")
241 (adjustment-method
242 (symbol 'randr)
243 "Color adjustment method.")
244
245 ;; Default values from redshift(1).
246 (daytime-temperature
247 (integer 6500)
248 "Daytime color temperature (kelvins).")
249 (nighttime-temperature
250 (integer 4500)
251 "Nighttime color temperature (kelvins).")
252
253 (daytime-brightness
254 maybe-inexact-number
255 "Daytime screen brightness, between 0.1 and 1.0.")
256 (nighttime-brightness
257 maybe-inexact-number
258 "Nighttime screen brightness, between 0.1 and 1.0.")
259
260 (latitude
261 maybe-inexact-number
262 "Latitude, when @code{location-provider} is @code{'manual}.")
263 (longitude
264 maybe-inexact-number
265 "Longitude, when @code{location-provider} is @code{'manual}.")
266
267 (dawn-time
268 maybe-string
269 "Custom time for the transition from night to day in the
270morning---@code{\"HH:MM\"} format. When specified, solar elevation is not
271used to determine the daytime/nighttime period.")
272 (dusk-time
273 maybe-string
274 "Likewise, custom time for the transition from day to night in the
275evening.")
276
277 (extra-content
278 (raw-configuration-string "")
279 "Extra content appended as-is to the Redshift configuration file. Run
280@command{man redshift} for more information about the configuration file
281format."))
282
283(define (serialize-redshift-configuration config)
284 (define location-fields
285 '(latitude longitude))
286
287 (define (location-field? field)
288 (memq (configuration-field-name field) location-fields))
289
290 (define (secondary-field? field)
291 (or (location-field? field)
292 (memq (configuration-field-name field)
293 '(redshift extra-content))))
294
295 #~(string-append
296 "[redshift]\n"
297 #$(serialize-configuration config
298 (remove secondary-field?
299 home-redshift-configuration-fields))
300
301 #$(home-redshift-configuration-extra-content config)
302
303 "\n[manual]\n"
304 #$(serialize-configuration config
305 (filter location-field?
306 home-redshift-configuration-fields))))
307
308(define (redshift-shepherd-service config)
309 (define config-file
310 (computed-file "redshift.conf"
311 #~(call-with-output-file #$output
312 (lambda (port)
313 (display #$(serialize-redshift-configuration config)
314 port)))))
315
316 (list (shepherd-service
317 (documentation "Redshift program.")
318 (provision '(redshift))
319
320 ;; Depend on 'x11-display', which sets 'DISPLAY' if an X11 server is
321 ;; available, and fails to start otherwise.
322 (requirement '(x11-display))
323
324 (modules '((srfi srfi-1)
325 (srfi srfi-26)))
326 (start #~(lambda _
327 (fork+exec-command
328 (list #$(file-append
329 (home-redshift-configuration-redshift config)
330 "/bin/redshift")
331 "-c" #$config-file)
332
333 ;; Inherit the 'DISPLAY' variable set by 'x11-display'.
334 #:environment-variables
335 (cons (string-append "DISPLAY=" (getenv "DISPLAY"))
336 (remove (cut string-prefix? "DISPLAY=" <>)
337 (default-environment-variables))))))
338 (stop #~(make-kill-destructor))
339 (actions (list (shepherd-configuration-action config-file))))))
340
341(define home-redshift-service-type
342 (service-type
343 (name 'home-redshift)
344 (extensions (list (service-extension home-shepherd-service-type
345 redshift-shepherd-service)
346 ;; Ensure 'home-x11-service-type' is instantiated so we
347 ;; can depend on the Shepherd 'x11-display' service.
348 (service-extension home-x11-service-type
349 (const #t))))
350 (default-value (home-redshift-configuration))
351 (description
352 "Run Redshift, a program that adjusts the color temperature of display
353according to time of day.")))
354
355
356;;;
357;;; D-Bus.
358;;;
359
360(define-record-type* <home-dbus-configuration>
361 home-dbus-configuration make-home-dbus-configuration
362 home-dbus-configuration?
363 (dbus home-dbus-dbus ;file-like
364 (default dbus)))
365
366(define (home-dbus-shepherd-services config)
367 (list (shepherd-service
368 (documentation "Run the D-Bus daemon in session-specific mode.")
369 (provision '(dbus))
370 (modules '((shepherd support))) ;for '%user-log-dir'
371 (start #~(make-forkexec-constructor
372 (list #$(file-append (home-dbus-dbus config)
373 "/bin/dbus-daemon")
374 "--nofork" "--session"
375 (format #f "--address=unix:path=~a/bus"
376 (or (getenv "XDG_RUNTIME_DIR")
377 (format #f "/run/user/~a"
378 (getuid)))))
379 #:environment-variables
380 (cons "DBUS_VERBOSE=1"
381 (default-environment-variables))
382 #:log-file
383 (string-append %user-log-dir "/dbus.log")))
384 (stop #~(make-kill-destructor)))))
385
386(define (home-dbus-environment-variables config)
387 '(("DBUS_SESSION_BUS_ADDRESS"
388 . "unix:path=${XDG_RUNTIME_DIR:-/run/user/$UID}/bus")))
389
390(define home-dbus-service-type
391 (service-type
392 (name 'home-dbus)
393 (extensions
394 (list (service-extension home-shepherd-service-type
395 home-dbus-shepherd-services)
396 (service-extension home-environment-variables-service-type
397 home-dbus-environment-variables)))
398 (default-value (home-dbus-configuration))
399 (description
400 "Run the session-specific D-Bus inter-process message bus.")))
401
402
403;;;
404;;; Unclutter.
405;;;
406
407(define-configuration/no-serialization home-unclutter-configuration
408 (unclutter
409 (file-like unclutter)
410 "The @code{unclutter} package to use.")
411 (idle-timeout
412 (integer 5)
413 "Timeout in seconds after which to hide the cursor."))
414
415(define (home-unclutter-shepherd-service config)
416 (list
417 (shepherd-service
418 (provision '(unclutter))
419 ;; Depend on 'x11-display', which sets 'DISPLAY' if an X11 server is
420 ;; available, and fails to start otherwise.
421 (requirement '(x11-display))
422 (modules '((shepherd support) ;for %user-log-dir
423 (srfi srfi-1)
424 (srfi srfi-26)))
425 (start #~(lambda _
426 (fork+exec-command
427 (list
428 #$(file-append
429 (home-unclutter-configuration-unclutter config)
430 "/bin/unclutter")
431 "-idle"
432 (number->string
433 #$(home-unclutter-configuration-idle-timeout config)))
434 ;; Inherit the 'DISPLAY' variable set by 'x11-display'.
435 #:environment-variables
436 (cons (string-append "DISPLAY=" (getenv "DISPLAY"))
437 (remove (cut string-prefix? "DISPLAY=" <>)
438 (default-environment-variables)))
439 #:log-file
440 (string-append %user-log-dir "/unclutter.log"))))
441 (stop #~(make-kill-destructor)))))
442
443(define home-unclutter-service-type
444 (service-type
445 (name 'home-unclutter)
446 (extensions
447 (list
448 (service-extension home-shepherd-service-type
449 home-unclutter-shepherd-service)))
450 (default-value (home-unclutter-configuration))
451 (description "Run the @code{unclutter} daemon, which, on systems using the
452Xorg graphical display server, automatically hides the cursor after a
453user-defined timeout has expired.")))
454
455
456;;;
457;;; Xmodmap.
458;;;
459
460(define-configuration/no-serialization home-xmodmap-configuration
461 (xmodmap
462 (file-like xmodmap)
463 "The @code{xmodmap} package to use.")
464 (key-map
465 (list '())
466 "List of expressions to be read by @code{xmodmap} on service startup."))
467
468(define (serialize-xmodmap-configuration field-name val)
469 (define serialize-field
470 (match-lambda
471 ((key . value)
472 (format #f "~a = ~a" key value))
473 (e e)))
474
475 #~(string-append
476 #$@(interpose (map serialize-field val) "\n" 'suffix)))
477
478(define (xmodmap-shepherd-service config)
479 (define config-file
480 (mixed-text-file
481 "config"
482 (serialize-xmodmap-configuration
483 #f (home-xmodmap-configuration-key-map config))))
484
485 (list
486 (shepherd-service
487 (provision '(xmodmap))
488 (start #~(make-system-constructor
489 (string-join
490 (list #$(file-append
491 (home-xmodmap-configuration-xmodmap config)
492 "/bin/xmodmap")
493 #$config-file))))
494 (stop #~(make-system-constructor
495 #$(file-append setxkbmap "/bin/setxkbmap")))
496 (documentation "On startup, run @code{xmodmap} and read the expressions in
497the configuration file. On stop, reset all the mappings back to the
498defaults."))))
499
500(define home-xmodmap-service-type
501 (service-type
502 (name 'home-xmodmap)
503 (extensions
504 (list
505 (service-extension home-shepherd-service-type
506 xmodmap-shepherd-service)))
507 (default-value (home-xmodmap-configuration))
508 (description "Run the @code{xmodmap} utility to modify keymaps and pointer
509buttons under the Xorg display server via user-defined expressions.")))
510
511
512(define home-startx-command-service-type
513 (service-type
514 (inherit (system->home-service-type startx-command-service-type))
515 (default-value (for-home (xorg-configuration)))))
516
517(define-service-type-mapping
518 startx-command-service-type => home-startx-command-service-type)
519
520
521;;;
522;;; Darkman.
523;;;
524
525(define-maybe number)
526
527(define (serialize-number field value)
528 (string-append (match field
529 ('latitude "lat")
530 ('longitude "lng")
531 (_ (symbol->string field)))
532 ": " (number->string value) "\n"))
533
534(define (serialize-boolean field value)
535 (string-append (match field
536 ('use-geoclue "usegeoclue")
537 ('dbus-server "dbusserver")
538 (_ "portal"))
539 ": " (if value "true" "false") "\n"))
540
541(define-configuration home-darkman-configuration
542 (darkman
543 (file-like darkman)
544 "The @code{darkman} package to use.")
545
546 (latitude
547 maybe-number
548 "Latitude, used at startup or when @code{use-geoclue} is @code{#f}. More than
549one decimal point is generally not needed.")
550
551 (longitude
552 maybe-number
553 "Longitude, used at startup or when @code{use-geoclue} is @code{#f}. More than
554one decimal point is generally not needed.")
555
556 (use-geoclue
557 (boolean #f)
558 "Whether to use a local geoclue instance to determine the current location.
559Setting this to false without explicitly setting latitude and longtitude
560disables automatic transitions entirely.")
561
562 (dbus-server
563 (boolean #t)
564 "Whether to expose the current mode via darkman's own D-Bus API.")
565
566 (portal
567 (boolean #t)
568 "Whether to expose the current mode via the XDG settings portal D-Bus API."))
569
570(define (serialize-home-darkman-configuration config)
571 (mixed-text-file
572 "config.yaml"
573 (serialize-configuration config home-darkman-configuration-fields)))
574
575(define (home-darkman-configuration-files config)
576 `(("darkman/config.yaml" ,(serialize-home-darkman-configuration config))))
577
578(define (home-darkman-profile-service config)
579 (list (home-darkman-configuration-darkman config)))
580
581(define (home-darkman-shepherd-service config)
582 (list
583 (shepherd-service
584 (provision '(darkman))
585 (requirement '(dbus))
586 (modules '((shepherd support))) ;for '%user-log-dir'
587 (start #~(make-forkexec-constructor
588 (list #$(file-append (home-darkman-configuration-darkman config)
589 "/bin/darkman")
590 "run")
591 #:log-file
592 (string-append %user-log-dir "/darkman.log")))
593 (stop #~(make-kill-destructor)))))
594
595(define home-darkman-service-type
596 (service-type
597 (name 'home-darkman)
598 (extensions
599 (list (service-extension home-shepherd-service-type
600 home-darkman-shepherd-service)
601 (service-extension home-xdg-configuration-files-service-type
602 home-darkman-configuration-files)
603 (service-extension home-profile-service-type
604 home-darkman-profile-service)))
605 (default-value (home-darkman-configuration))
606 (description "Run the @code{darkman} daemon, which will invoke scripts in
607$XDG_DATA_DIRS/dark-mode.d/ when sundown, and invoke scripts in
608$XDG_DATA_DIRS/light-mode.d/ when sunrise.")))