From patchwork Sun Jan 23 11:11:59 2022 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 8bit X-Patchwork-Submitter: =?utf-8?q?Ludovic_Court=C3=A8s?= X-Patchwork-Id: 36763 Return-Path: X-Original-To: patchwork@mira.cbaines.net Delivered-To: patchwork@mira.cbaines.net Received: by mira.cbaines.net (Postfix, from userid 113) id 5129C27BBEA; Sun, 23 Jan 2022 11:13:10 +0000 (GMT) X-Spam-Checker-Version: SpamAssassin 3.4.6 (2021-04-09) on mira.cbaines.net X-Spam-Level: X-Spam-Status: No, score=-2.7 required=5.0 tests=BAYES_00,DKIM_INVALID, DKIM_SIGNED,MAILING_LIST_MULTI,RCVD_IN_MSPIKE_H3,RCVD_IN_MSPIKE_WL, SPF_HELO_PASS,URIBL_BLOCKED autolearn=unavailable autolearn_force=no version=3.4.6 Received: from lists.gnu.org (lists.gnu.org [209.51.188.17]) by mira.cbaines.net (Postfix) with ESMTPS id 93D7E27BBE9 for ; Sun, 23 Jan 2022 11:13:09 +0000 (GMT) Received: from localhost ([::1]:48316 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1nBao0-0005Vh-P4 for patchwork@mira.cbaines.net; Sun, 23 Jan 2022 06:13:08 -0500 Received: from eggs.gnu.org ([209.51.188.92]:52644) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1nBanv-0005VZ-7y for guix-patches@gnu.org; Sun, 23 Jan 2022 06:13:03 -0500 Received: from debbugs.gnu.org ([209.51.188.43]:45749) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1nBant-0000dN-Sd for guix-patches@gnu.org; Sun, 23 Jan 2022 06:13:02 -0500 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1nBant-0005No-Pb for guix-patches@gnu.org; Sun, 23 Jan 2022 06:13:01 -0500 X-Loop: help-debbugs@gnu.org Subject: [bug#53466] [PATCH] home: Add redshift service. Resent-From: Ludovic =?utf-8?q?Court=C3=A8s?= Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Sun, 23 Jan 2022 11:13:01 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: report 53466 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch To: 53466@debbugs.gnu.org Cc: Ludovic =?utf-8?q?Court=C3=A8s?= X-Debbugs-Original-To: guix-patches@gnu.org Received: via spool by submit@debbugs.gnu.org id=B.164293634720647 (code B ref -1); Sun, 23 Jan 2022 11:13:01 +0000 Received: (at submit) by debbugs.gnu.org; 23 Jan 2022 11:12:27 +0000 Received: from localhost ([127.0.0.1]:38652 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1nBanK-0005Mw-E0 for submit@debbugs.gnu.org; Sun, 23 Jan 2022 06:12:26 -0500 Received: from lists.gnu.org ([209.51.188.17]:50394) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1nBanI-0005Mo-Uh for submit@debbugs.gnu.org; Sun, 23 Jan 2022 06:12:25 -0500 Received: from eggs.gnu.org ([209.51.188.92]:52434) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1nBanH-0005Sj-63 for guix-patches@gnu.org; Sun, 23 Jan 2022 06:12:24 -0500 Received: from [2001:470:142:3::e] (port=40084 helo=fencepost.gnu.org) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1nBanF-0000Z8-8w; Sun, 23 Jan 2022 06:12:22 -0500 DKIM-Signature: v=1; a=rsa-sha256; q=dns/txt; c=relaxed/relaxed; d=gnu.org; s=fencepost-gnu-org; h=MIME-Version:Date:Subject:To:From:in-reply-to: references; bh=oqlCjMjzK38TqLJVTTrr+Cmv92Xm7qRoLmYU3+5In/4=; b=iOV9gF3pLp2V33 j/mI81iEgsU9C3O/T+8uOhG1CpXc649W7Px/B4HORY3fqmW6ptc3VVFTsCcf6Rl+kU/0gX0UlcJOo DmBMsjnonyGjoxtbS+VRj7AJdpCWxcvWitenShui8PG9xRoX4Z29Ol8MHE+3EWr6kpE5uTGF1MfBY QWItDN/zNzFnYt0/VQoU3mwU9iPDzElBYX+cErZM0zE+YDcloO0TWLCsBB9Vp8QJP9erLWA4mcM/j F2hqrsXKr13CdQJbUkG0fSiVw4fkE65lnwWcsu9VL8wlbsMhFj7GGJjKIqm3KcHns6wNsmnwlqkgN 7LIVvqkuOF6bxLo0ssyw==; Received: from [2a01:e0a:1d:7270:af76:b9b:ca24:c465] (port=57242 helo=gnu.org) by fencepost.gnu.org with esmtpsa (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1nBan4-00030U-F0; Sun, 23 Jan 2022 06:12:20 -0500 From: Ludovic =?utf-8?q?Court=C3=A8s?= Date: Sun, 23 Jan 2022 12:11:59 +0100 Message-Id: <20220123111159.27020-1-ludo@gnu.org> X-Mailer: git-send-email 2.34.0 MIME-Version: 1.0 X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-BeenThere: guix-patches@gnu.org List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guix-patches-bounces+patchwork=mira.cbaines.net@gnu.org Sender: "Guix-patches" X-getmail-retrieved-from-mailbox: Patches * 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 base-commit: ee6bf00b2d89f6acab55b7a82896d99e39c1229b 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 +;;; +;;; 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 . + +(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 \