(address . guix-patches@gnu.org)(name . Ludovic Courtès)(address . ludo@gnu.org)
* gnu/home/services/desktop.scm: New file.
* gnu/local.mk (GNU_SYSTEM_MODULES): Add it.
* doc/guix.texi (Desktop Home Services): New node.
---
doc/guix.texi | 62 ++++++++++++++++
gnu/home/services/desktop.scm | 135 ++++++++++++++++++++++++++++++++++
gnu/local.mk | 1 +
3 files changed, 198 insertions(+)
create mode 100644 gnu/home/services/desktop.scm
Toggle diff (237 lines)
diff --git a/doc/guix.texi b/doc/guix.texi
index 912a8e3c5a..07414ec13d 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -37186,6 +37186,7 @@ services)}.
* Shells: Shells Home Services. POSIX shells, Bash, Zsh.
* Mcron: Mcron Home Service. Scheduled User's Job Execution.
* Shepherd: Shepherd Home Service. Managing User's Daemons.
+* Desktop: Desktop Home Services. Services for graphical environments.
@end menu
@c In addition to that Home Services can provide
@@ -37567,6 +37568,67 @@ mechanism instead (@pxref{Shepherd Services}).
@end table
@end deftp
+@node Desktop Home Services
+@subsection Desktop Home Services
+
+The @code{(gnu home services desktop)} module provides services that you
+may find useful on ``desktop'' systems running a graphical user
+environment such as Xorg.
+
+@defvr {Scheme Variable} home-redshift-service-type
+This is the service type for @uref{https://github.com/jonls/redshift,
+Redshift}, a program that adjusts the display color temperature
+according to the time of day. Its associated value must be a
+@code{home-redshift-configuration} record, as shown below.
+
+A typical configuration, where we manually specify the latitude and
+longitude, might look like this:
+
+@lisp
+(service home-redshift-service-type
+ (home-redshift-configuration
+ (location-provider 'manual)
+ (latitude 35.81) ;northern hemisphere
+ (longitude -0.80))) ;west of Greenwich
+@end lisp
+@end defvr
+
+@deftp {Data Type} home-redshift-configuration
+Available @code{home-redshift-configuration} fields are:
+
+@table @asis
+@item @code{location-provider} (default: @code{geoclue2}) (type: symbol)
+Geolocation provider---@code{'manual} or @code{'geoclue2}. In the
+former case, you must also specify the @code{latitude} and
+@code{longitude} fields so Redshift can determine daytime at your place.
+In the latter case, the Geoclue system service must be running; it will
+be queried for location information.
+
+@item @code{adjustment-method} (default: @code{randr}) (type: symbol)
+Color adjustment method.
+
+@item @code{daytime-temperature} (default: @code{6500}) (type: integer)
+Daytime color temperature (kelvins).
+
+@item @code{nighttime-temperature} (default: @code{4500}) (type: integer)
+Nighttime color temperature (kelvins).
+
+@item @code{daytime-brightness} (default: @code{disabled}) (type: maybe-inexact-number)
+Daytime screen brightness, between 0.1 and 1.0.
+
+@item @code{nighttime-brightness} (default: @code{disabled}) (type: maybe-inexact-number)
+Nighttime screen brightness, between 0.1 and 1.0.
+
+@item @code{latitude} (default: @code{disabled}) (type: maybe-inexact-number)
+Latitude, when @code{location-provider} is @code{'manual}.
+
+@item @code{longitude} (default: @code{disabled}) (type: maybe-inexact-number)
+Longitude, when @code{location-provider} is @code{'manual}.
+
+@end table
+
+@end deftp
+
@node Invoking guix home
@section Invoking @code{guix home}
diff --git a/gnu/home/services/desktop.scm b/gnu/home/services/desktop.scm
new file mode 100644
index 0000000000..36e02e671f
--- /dev/null
+++ b/gnu/home/services/desktop.scm
@@ -0,0 +1,135 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2022 Ludovic Courtès <ludo@gnu.org>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (gnu home services desktop)
+ #:use-module (gnu home services)
+ #:use-module (gnu home services shepherd)
+ #:use-module (gnu services configuration)
+ #:autoload (gnu packages xdisorg) (redshift)
+ #:use-module (guix records)
+ #:use-module (guix gexp)
+ #:use-module (srfi srfi-1)
+ #:use-module (ice-9 match)
+ #:export (home-redshift-configuration
+ home-redshift-configuration?
+
+ home-redshift-service-type))
+
+
+;;;
+;;; Redshift.
+;;;
+
+(define (serialize-integer field value)
+ (string-append (match field
+ ('daytime-temperature "temp-day")
+ ('nighttime-temperature "temp-night")
+ ('daytime-brightness "brightness-day")
+ ('nighttime-brightness "brightness-night")
+ ('latitude "lat")
+ ('longitude "lon")
+ (_ (symbol->string field)))
+ "=" (number->string value) "\n"))
+
+(define (serialize-symbol field value)
+ (string-append (symbol->string field)
+ "=" (symbol->string value) "\n"))
+
+(define serialize-inexact-number serialize-integer)
+
+(define (inexact-number? n)
+ (and (number? n) (inexact? n)))
+(define-maybe inexact-number)
+
+(define-configuration home-redshift-configuration
+ (location-provider
+ (symbol 'geoclue2)
+ "Geolocation provider---@code{'manual} or @code{'geoclue2}.
+
+In the former case, you must also specify the @code{latitude} and
+@code{longitude} fields so Redshift can determine daytime at your place. In
+the latter case, the Geoclue system service must be running; it will be
+queried for location information.")
+ (adjustment-method
+ (symbol 'randr)
+ "Color adjustment method.")
+
+ ;; Default values from redshift(1).
+ (daytime-temperature
+ (integer 6500)
+ "Daytime color temperature (kelvins).")
+ (nighttime-temperature
+ (integer 4500)
+ "Nighttime color temperature (kelvins).")
+
+ (daytime-brightness
+ (maybe-inexact-number 'disabled)
+ "Daytime screen brightness, between 0.1 and 1.0.")
+ (nighttime-brightness
+ (maybe-inexact-number 'disabled)
+ "Nighttime screen brightness, between 0.1 and 1.0.")
+
+ (latitude
+ (maybe-inexact-number 'disabled)
+ "Latitude, when @code{location-provider} is @code{'manual}.")
+ (longitude
+ (maybe-inexact-number 'disabled)
+ "Longitude, when @code{location-provider} is @code{'manual}."))
+
+(define (serialize-redshift-configuration config)
+ (define location-fields
+ '(latitude longitude))
+
+ (define (location-field? field)
+ (memq (configuration-field-name field) location-fields))
+
+ #~(string-append
+ "[redshift]\n"
+ #$(serialize-configuration config
+ (remove location-field?
+ home-redshift-configuration-fields))
+ "\n[manual]\n"
+ #$(serialize-configuration config
+ (filter location-field?
+ home-redshift-configuration-fields))))
+
+(define (redshift-shepherd-service config)
+ (define config-file
+ (computed-file "redshift.conf"
+ #~(call-with-output-file #$output
+ (lambda (port)
+ (display #$(serialize-redshift-configuration config)
+ port)))))
+
+ (list (shepherd-service
+ (documentation "Redshift program.")
+ (provision '(redshift))
+ (start #~(make-forkexec-constructor
+ (list #$(file-append redshift "/bin/redshift")
+ "-c" #$config-file)))
+ (stop #~(make-kill-destructor)))))
+
+(define home-redshift-service-type
+ (service-type
+ (name 'home-redshift)
+ (extensions (list (service-extension home-shepherd-service-type
+ redshift-shepherd-service)))
+ (default-value (home-redshift-configuration))
+ (description
+ "Run Redshift, a program that adjust the color temperature of display
+according to time of day.")))
diff --git a/gnu/local.mk b/gnu/local.mk
index 03f6d90b9e..cf72926f5d 100644
--- a/gnu/local.mk
+++ b/gnu/local.mk
@@ -78,6 +78,7 @@ GNU_SYSTEM_MODULES = \
%D%/ci.scm \
%D%/home.scm \
%D%/home/services.scm \
+ %D%/home/services/desktop.scm \
%D%/home/services/symlink-manager.scm \
%D%/home/services/fontutils.scm \
%D%/home/services/shells.scm \
base-commit: ee6bf00b2d89f6acab55b7a82896d99e39c1229b
--
2.34.0