Received: (at 75048) by debbugs.gnu.org; 3 Jan 2025 02:31:37 +0000 From debbugs-submit-bounces <at> debbugs.gnu.org Thu Jan 02 21:31:37 2025 Received: from localhost ([127.0.0.1]:48944 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from <debbugs-submit-bounces <at> debbugs.gnu.org>) id 1tTXTN-0008Ow-0N for submit <at> debbugs.gnu.org; Thu, 02 Jan 2025 21:31:37 -0500 Received: from m16.mail.163.com ([220.197.31.4]:57496) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from <tumashu@HIDDEN>) id 1tTXTI-0008Ok-IR for 75048 <at> debbugs.gnu.org; Thu, 02 Jan 2025 21:31:35 -0500 DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=163.com; s=s110527; h=From:Subject:Date:Message-ID:MIME-Version: Content-Type; bh=rWy50QN0Ij5+5NUndkFdBXqv+DaJVXWoSrJecBFSWuU=; b=JdvJ2R2VBZ5NeZOrvDVdyv2qOP05z7quIMECIGqActbtUyBxwBtoNUmX2pd55c cUpVdEgVvnhUcLTbYUvQtbqMKweWUJxTZKn2YvY7iahzuCv8EX7h4FzKXwqWKw7u koSES8FRfb2Ia7xb2VqYFZ7msDXV7urig+EvPYgncWbs4= Received: from Tumashu (unknown []) by gzga-smtp-mtada-g1-0 (Coremail) with SMTP id _____wD35x3xS3dnCaIJDg--.58868S2; Fri, 03 Jan 2025 10:31:14 +0800 (CST) From: Feng Shu <tumashu@HIDDEN> To: 75048 <at> debbugs.gnu.org Subject: Re: [PATCH] Add lightdm-greeter-general-configuration and do not hard code config type name everywhere. Date: Fri, 03 Jan 2025 10:31:13 +0800 Message-ID: <87ikqw8w7i.fsf@HIDDEN> User-Agent: Gnus/5.13 (Gnus v5.13) MIME-Version: 1.0 Content-Type: text/plain X-CM-TRANSID: _____wD35x3xS3dnCaIJDg--.58868S2 X-Coremail-Antispam: 1Uf129KBjDUn29KB7ZKAUJUUUUU529EdanIXcx71UUUUU7v73 VFW2AGmfu7bjvjm3AaLaJ3UbIYCTnIWIevJa73UjIFyTuYvj4RHOJYUUUUU X-Originating-IP: [218.92.14.78] X-CM-SenderInfo: 5wxpt2lkx6il2tof0z/1tbiRRPJ1Gd3SLJYUQABsp X-Spam-Score: 0.0 (/) X-Debbugs-Envelope-To: 75048 X-BeenThere: debbugs-submit <at> debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: <debbugs-submit.debbugs.gnu.org> List-Unsubscribe: <https://debbugs.gnu.org/cgi-bin/mailman/options/debbugs-submit>, <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=unsubscribe> List-Archive: <https://debbugs.gnu.org/cgi-bin/mailman/private/debbugs-submit/> List-Post: <mailto:debbugs-submit <at> debbugs.gnu.org> List-Help: <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=help> List-Subscribe: <https://debbugs.gnu.org/cgi-bin/mailman/listinfo/debbugs-submit>, <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=subscribe> Errors-To: debbugs-submit-bounces <at> debbugs.gnu.org Sender: "Debbugs-submit" <debbugs-submit-bounces <at> debbugs.gnu.org> X-Spam-Score: -1.0 (-) In v7 patch, I do not use local-eval, which simplify code a lot. --
guix-patches@HIDDEN:bug#75048; Package guix-patches.
Full text available.
Received: (at 75048) by debbugs.gnu.org; 3 Jan 2025 02:28:15 +0000
From debbugs-submit-bounces <at> debbugs.gnu.org Thu Jan 02 21:28:15 2025
Received: from localhost ([127.0.0.1]:48903 helo=debbugs.gnu.org)
by debbugs.gnu.org with esmtp (Exim 4.84_2)
(envelope-from <debbugs-submit-bounces <at> debbugs.gnu.org>)
id 1tTXQ6-0008At-2b
for submit <at> debbugs.gnu.org; Thu, 02 Jan 2025 21:28:15 -0500
Received: from m16.mail.163.com ([220.197.31.2]:53426)
by debbugs.gnu.org with esmtp (Exim 4.84_2)
(envelope-from <tumashu@HIDDEN>) id 1tTXPy-0008AQ-PI
for 75048 <at> debbugs.gnu.org; Thu, 02 Jan 2025 21:28:11 -0500
DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=163.com;
s=s110527; h=From:Subject:Date:Message-ID:MIME-Version; bh=BjV4G
SN1g1VnVAApmQvNFCJdkNZvcTSnTj7xtK8urTU=; b=HCACtfctlsHH08CSpKnA9
TgiwUcC1xFgtdllRz9qMDy4dFm25y0EREB4mxwqZAzNHF+yelgdAZ1UwTFafC0OX
8norHHRpwf8SLTP7gn8fbfbUg2SKXmHcKYRRiA455B70gE/zhcdGCFH143How2eK
vIKb2ZzyAgV+R2IESdFktw=
Received: from localhost.localdomain (unknown [])
by gzga-smtp-mtada-g1-1 (Coremail) with SMTP id
_____wDndwMuS3dnM1IGDg--.38221S2;
Fri, 03 Jan 2025 10:27:58 +0800 (CST)
From: tumashu@HIDDEN
To: 75048 <at> debbugs.gnu.org
Subject: [PATCH v7] Add lightdm-greeter-general-configuration and do not hard
code config type name everywhere.
Date: Fri, 3 Jan 2025 10:27:53 +0800
Message-ID: <20250103022756.31217-1-tumashu@HIDDEN>
X-Mailer: git-send-email 2.45.2
MIME-Version: 1.0
X-Debbugs-Cc: Feng Shu <tumashu@HIDDEN>, tumashu@HIDDEN
Content-Transfer-Encoding: 8bit
X-CM-TRANSID: _____wDndwMuS3dnM1IGDg--.38221S2
X-Coremail-Antispam: 1Uf129KBjvAXoWfZF4rCFyDWF43Gw4UZFW8WFg_yoW8trykAo
Z3uFW7Gr47Cr17WFnayr1fCr47Jryv9r48Zr18Jry7Cw1vqF43Ja4Yqay8ZF42kr4jkrn8
Gr95ua9xAayjyF4rn29KB7ZKAUJUUUU8529EdanIXcx71UUUUU7v73VFW2AGmfu7bjvjm3
AaLaJ3UbIYCTnIWIevJa73UjIFyTuYvjTRZyCpDUUUU
X-Originating-IP: [218.92.14.78]
X-CM-SenderInfo: 5wxpt2lkx6il2tof0z/1tbiEQvJ1Gd3RGbvUQAAsL
X-Spam-Score: 0.0 (/)
X-Debbugs-Envelope-To: 75048
Cc: Feng Shu <tumashu@HIDDEN>
X-BeenThere: debbugs-submit <at> debbugs.gnu.org
X-Mailman-Version: 2.1.18
Precedence: list
List-Id: <debbugs-submit.debbugs.gnu.org>
List-Unsubscribe: <https://debbugs.gnu.org/cgi-bin/mailman/options/debbugs-submit>,
<mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=unsubscribe>
List-Archive: <https://debbugs.gnu.org/cgi-bin/mailman/private/debbugs-submit/>
List-Post: <mailto:debbugs-submit <at> debbugs.gnu.org>
List-Help: <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=help>
List-Subscribe: <https://debbugs.gnu.org/cgi-bin/mailman/listinfo/debbugs-submit>,
<mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=subscribe>
Errors-To: debbugs-submit-bounces <at> debbugs.gnu.org
Sender: "Debbugs-submit" <debbugs-submit-bounces <at> debbugs.gnu.org>
X-Spam-Score: -1.0 (-)
From: Feng Shu <tumashu@HIDDEN>
* gnu/services/lightdm.scm (gnu): Export new option variables.
(lightdm-gtk-greeter-configuration): Add greeter-session-name,
greeter-package, greeter-config-name fields.
(lightdm-greeter-general-configuration): New variable.
(strip-record-type-name-brackets): Return string instead symbol.
(config->type-name): Rename from config->name.
(greeter-configuration-field): New function.
(greeter-configuration->conf-name): Improve.
(greeter-configuration->session-name): New variable.
(greeter-configuration-valid?): New function.
(greeter-configuration->packages): Do not hard code greeter configuation name.
(greeter-configuration->greeter-fields: removed.
(serialize-configuration*): Removed.
(greeter-configuration->file): Call different function based config type.
(greeter-configuration-file-info): New variable.
(lightdm-gtk-greeter-configuration->file)
(lightdm-greeter-general-configuration->file): New functions.
(greeter-session?): Do not hard code greeter configuation name.
(greeter-session->greater-configuration-pred)
(greeter-configuration->greeter-session): Removed.
(greeter-configuration?): Do not hard code greeter configuation name.
(lightdm-configuration): Add lightdm-greeter-general-configuration.
(validate-lightdm-configuration): Do not use greeter-session->greater-configuration-pred.
(generate-doc): Handle lightdm-greeter-general-configuration.
* doc/guix.texi (X Window): Improve lightdm-gtk-greeter-configuration options
doc, Add lightdm-greeter-general-configuration,
Change-Id: Iae22cd641454c86280e88d6986594ad0c8f4c490
---
doc/guix.texi | 86 +++++++++++++-
gnu/services/lightdm.scm | 246 ++++++++++++++++++++++++++-------------
2 files changed, 245 insertions(+), 87 deletions(-)
diff --git a/doc/guix.texi b/doc/guix.texi
index 924f13f0f6..b6c3fd37da 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -23824,8 +23824,7 @@ In its most basic form, it can be used simply as:
(service lightdm-service-type)
@end lisp
-A more elaborate example making use of the VNC capabilities and enabling
-more features and verbose logs could look like:
+Two more elaborate examples look like below:
@lisp
(service lightdm-service-type
@@ -23841,6 +23840,38 @@ more features and verbose logs could look like:
(name "*")
(user-session "ratpoison"))))))
@end lisp
+
+@lisp
+(service lightdm-service-type
+ (lightdm-configuration
+ (greeters
+ (list (lightdm-greeter-general-configuration
+ (greeter-package lightdm-mini-greeter)
+ (greeter-session-name "lightdm-mini-greeter")
+ (greeter-config-name "lightdm-mini-greeter.conf")
+ (config (list "[greeter]"
+ "user = guest")))
+ (lightdm-gtk-greeter-configuration
+ (extra-config
+ (list "font-name = San 10"
+ "xft-dpi = 140"
+ "clock-format = %Y-%m-%d %H:%M"
+ ;; We need to use "~~" to generate a tilde, for
+ ;; extra-config sting will be handle as
+ ;; control-string of format function.
+ "indicators = ~~host;~~spacer;~~session;~~a11y;~~clock;~~power")))))
+ (seats
+ (list (lightdm-seat-configuration
+ (name "*")
+ (greeter-session 'lightdm-mini-greeter))))
+ (xorg-configuration
+ (xorg-configuration
+ (server-arguments
+ (append %default-xorg-server-arguments
+ '("-dpi" "140")))))))
+@end lisp
+
+
@end defvar
@c The LightDM service documentation can be auto-generated via the
@@ -23925,8 +23956,14 @@ Extra configuration values to append to the LightDM configuration file.
Available @code{lightdm-gtk-greeter-configuration} fields are:
@table @asis
-@item @code{lightdm-gtk-greeter} (default: @code{lightdm-gtk-greeter}) (type: file-like)
-The lightdm-gtk-greeter package to use.
+@item @code{greeter-package} (default: @code{lightdm-gtk-greeter}) (type: file-like)
+The greeter package to use.
+
+@item @code{greeter-session-name} (default: @code{lightdm-gtk-greeter}) (type: string)
+The session name used in lightdm.conf.
+
+@item @code{greeter-config-name} (default: @code{lightdm-gtk-greeter.conf}) (type: string)
+The greeter config file name in /etc/lightdm directory.
@item @code{assets} (default: @code{(adwaita-icon-theme gnome-themes-extra hicolor-icon-theme)}) (type: list-of-file-likes)
The list of packages complementing the greeter, such as package
@@ -23970,6 +24007,47 @@ configuration file.
@c %end of fragment
@c %start of fragment
+@deftp {Data Type} lightdm-greeter-general-configuration
+
+@code{lightdm-greeter-general-configuration} support all text config
+greeters which have no build-in configuration type like
+@code{lightdm-gtk-greeter-configuration}, such as lightdm-mini-greeter,
+for example:
+
+@lisp
+(lightdm-greeter-general-configuration
+ (greeter-package lightdm-mini-greeter)
+ (greeter-session-name "lightdm-mini-greeter")
+ (greeter-config-name "lightdm-mini-greeter.conf")
+ (config (list "[greeter]"
+ "user = guest")))
+@end lisp
+
+Available @code{lightdm-greeter-general-configuration} fields are:
+
+@table @asis
+@item @code{greeter-package} (type: maybe-file-like)
+The greeter package to use.
+
+@item @code{greeter-session-name} (type: maybe-string)
+The session name used in lightdm.conf.
+
+@item @code{greeter-config-name} (type: maybe-string)
+The greeter config file name in /etc/lightdm directory.
+
+@item @code{assets} (default: @code{(adwaita-icon-theme gnome-themes-extra hicolor-icon-theme)}) (type: list-of-file-likes)
+The list of packages complementing the greeter, such as package
+providing icon themes.
+
+@item @code{config} (default: @code{'()}) (type: list-of-strings)
+Configuration values of the LightDM Greeter configuration file.
+
+@end table
+@end deftp
+
+@c %end of fragment
+@c %start of fragment
+
@deftp {Data Type} lightdm-seat-configuration
Available @code{lightdm-seat-configuration} fields are:
diff --git a/gnu/services/lightdm.scm b/gnu/services/lightdm.scm
index 191cb5635b..a0d787bdb4 100644
--- a/gnu/services/lightdm.scm
+++ b/gnu/services/lightdm.scm
@@ -56,7 +56,10 @@ (define-module (gnu services lightdm)
lightdm-gtk-greeter-configuration
lightdm-gtk-greeter-configuration?
lightdm-gtk-greeter-configuration-lightdm-gtk-greeter
+ lightdm-gtk-greeter-configuration-greeter-package
lightdm-gtk-greeter-configuration-assets
+ lightdm-gtk-greeter-configuration-greeter-config-name
+ lightdm-gtk-greeter-configuration-greeter-session-name
lightdm-gtk-greeter-configuration-theme-name
lightdm-gtk-greeter-configuration-icon-theme-name
lightdm-gtk-greeter-configuration-cursor-theme-name
@@ -66,6 +69,16 @@ (define-module (gnu services lightdm)
lightdm-gtk-greeter-configuration-reader
lightdm-gtk-greeter-configuration-extra-config
+ lightdm-greeter-general-configuration
+ lightdm-greeter-general-configuration?
+ lightdm-greeter-general-configuration-greeter-package
+ lightdm-greeter-general-configuration-assets
+ lightdm-greeter-general-configuration-greeter-config-name
+ lightdm-greeter-general-configuration-greeter-session-name
+ lightdm-greeter-general-configuration-config
+
+ greeter-configuration-file-info
+
lightdm-configuration
lightdm-configuration?
lightdm-configuration-lightdm
@@ -117,6 +130,8 @@ (define (serialize-file-like name value)
(define (serialize-list-of-a11y-states name value)
(format #f "~a=~a~%" name (string-join (map symbol->string value) ";")))
+(define-maybe string)
+
(define (serialize-string name value)
(format #f "~a=~a~%" name value))
@@ -127,9 +142,17 @@ (define (serialize-list-of-strings _ value)
(string-join value "\n"))
(define-configuration lightdm-gtk-greeter-configuration
+ (greeter-session-name
+ (string "lightdm-gtk-greeter")
+ "Session name used in lightdm.conf"
+ empty-serializer)
(lightdm-gtk-greeter
+ maybe-file-like
+ "Keep it for compatibility, use greeter-package field instead."
+ empty-serializer)
+ (greeter-package
(file-like lightdm-gtk-greeter)
- "The lightdm-gtk-greeter package to use."
+ "The greeter package to use."
empty-serializer)
(assets
(list-of-file-likes (list adwaita-icon-theme
@@ -140,6 +163,10 @@ (define-configuration lightdm-gtk-greeter-configuration
"The list of packages complementing the greeter, such as package providing
icon themes."
empty-serializer)
+ (greeter-config-name
+ (string "lightdm-gtk-greeter.conf")
+ "Greeter config file name in /etc/lightdm directory."
+ empty-serializer)
(theme-name
(string "Adwaita")
"The name of the theme to use.")
@@ -176,50 +203,87 @@ (define-configuration lightdm-gtk-greeter-configuration
"Extra configuration values to append to the LightDM GTK Greeter
configuration file."))
+(define-configuration lightdm-greeter-general-configuration
+ (greeter-package
+ maybe-file-like
+ "The greeter package to use."
+ empty-serializer)
+ (assets
+ (list-of-file-likes (list adwaita-icon-theme
+ gnome-themes-extra
+ ;; FIXME: hicolor-icon-theme should be in the
+ ;; packages of the desktop templates.
+ hicolor-icon-theme))
+ "The list of packages complementing the greeter, such as package providing
+icon themes."
+ empty-serializer)
+ (greeter-config-name
+ maybe-string
+ "Greeter config file name in /etc/lightdm directory."
+ empty-serializer)
+ (greeter-session-name
+ maybe-string
+ "Session name used in lightdm.conf"
+ empty-serializer)
+ (config
+ (list-of-strings '())
+ "Configuration values of the LightDM Greeter configuration file."))
+
(define (strip-record-type-name-brackets name)
"Remove the '<' and '>' brackets from NAME, a symbol."
(let ((name (symbol->string name)))
(if (and (string-prefix? "<" name)
(string-suffix? ">" name))
- (string->symbol (string-drop (string-drop-right name 1) 1))
+ (string-drop (string-drop-right name 1) 1)
(error "unexpected record type name" name))))
-(define (config->name config)
- "Return the constructor name (a symbol) from CONFIG."
+(define (config->type-name config)
+ "Return the type name of CONFIG."
(strip-record-type-name-brackets
(record-type-name (struct-vtable config))))
-(define (greeter-configuration->greeter-fields config)
- "Return the fields of CONFIG, a greeter configuration."
- (match config
- ;; Note: register any new greeter configuration here.
- ((? lightdm-gtk-greeter-configuration?)
- lightdm-gtk-greeter-configuration-fields)))
+(define (greeter-configuration-field config field)
+ "Return field value of config."
+ (let ((rtd (struct-vtable config)))
+ ((record-accessor rtd field) config)))
-(define (greeter-configuration->packages config)
- "Return the list of greeter packages, including assets, used by CONFIG, a
-greeter configuration."
- (match config
- ;; Note: register any new greeter configuration here.
- ((? lightdm-gtk-greeter-configuration?)
- (cons (lightdm-gtk-greeter-configuration-lightdm-gtk-greeter config)
- (lightdm-gtk-greeter-configuration-assets config)))))
-
-;;; TODO: Implement directly in (gnu services configuration), perhaps by
-;;; making the FIELDS argument optional.
-(define (serialize-configuration* config)
- "Like `serialize-configuration', but not requiring to provide a FIELDS
-argument."
- (define fields (greeter-configuration->greeter-fields config))
- (serialize-configuration config fields))
+(define (greeter-configuration->session-name config)
+ "Return the session name of CONFIG, a greeter configuration."
+ (greeter-configuration-field config 'greeter-session-name))
(define (greeter-configuration->conf-name config)
"Return the file name of CONFIG, a greeter configuration."
- (format #f "~a.conf" (greeter-configuration->greeter-session config)))
+ (greeter-configuration-field config 'greeter-config-name))
-(define (greeter-configuration->file config)
- "Serialize CONFIG into a file under the output directory, so that it can be
-easily added to XDG_CONF_DIRS."
+(define (greeter-configuration-valid? config)
+ "Check greeter-configuration CONFIG valid or not."
+ (let ((conf-name (greeter-configuration->conf-name config))
+ (session-name (greeter-configuration->session-name config)))
+ (and (string? conf-name)
+ (string? session-name)
+ (> (string-length conf-name) 0)
+ (> (string-length session-name) 0))))
+
+(define (greeter-configuration->packages config)
+ "Return the list of greeter packages, including assets, used by CONFIG, a
+greeter configuration."
+ (filter file-like?
+ (cons (greeter-configuration->greeter-package config)
+ (greeter-configuration-field config 'assets))))
+
+(define (greeter-configuration->greeter-package config)
+ "Return greeter package used by CONFIG, a greeter configuration."
+ (let ((type-name (config->type-name config))
+ (pkg1 (greeter-configuration-field config 'greeter-package)))
+ (if (eq? type-name "lightdm-gtk-greeter-configuration")
+ ;; Handle lightdm-gtk-greeter field for keeping it for compatibility.
+ (let ((pkg2 (greeter-configuration-field config 'lightdm-gtk-greeter)))
+ (if (file-like? pkg2) pkg2 pkg1))
+ pkg1)))
+
+(define (lightdm-gtk-greeter-configuration->file config)
+ "Serialize CONFIG (lightdm-gtk-greeter-configuration) into a file under the
+output directory, so that it can be easily added to XDG_CONF_DIRS."
(computed-file
(greeter-configuration->conf-name config)
#~(begin
@@ -227,7 +291,36 @@ (define (greeter-configuration->file config)
(lambda (port)
(format port (string-append
"[greeter]\n"
- #$(serialize-configuration* config))))))))
+ #$(serialize-configuration
+ config
+ lightdm-gtk-greeter-configuration-fields))))))))
+
+(define (lightdm-greeter-general-configuration->file config)
+ "Serialize CONFIG (lightdm-greeter-general-configuration) into a file under the
+output directory, so that it can be easily added to XDG_CONF_DIRS."
+ (computed-file
+ (greeter-configuration->conf-name config)
+ #~(begin
+ (call-with-output-file #$output
+ (lambda (port)
+ (format port #$(serialize-configuration
+ config
+ lightdm-greeter-general-configuration-fields)))))))
+
+;; The info used by greeter-configuration->file.
+(define greeter-configuration-file-info
+ `(("lightdm-gtk-greeter-configuration" .
+ ,lightdm-gtk-greeter-configuration->file)
+ ("lightdm-greeter-general-configuration" .
+ ,lightdm-greeter-general-configuration->file)))
+
+(define (greeter-configuration->file config)
+ "Serialize CONFIG into a file under the output directory, so that it can be
+easily added to XDG_CONF_DIRS."
+ (let* ((type-name (config->type-name config))
+ (func (assoc-ref greeter-configuration-file-info type-name)))
+ (when (procedure? func)
+ (func config))))
;;;
@@ -248,15 +341,14 @@ (define (serialize-seat-type name value)
(define-maybe seat-type)
(define (greeter-session? value)
- (memq value '(lightdm-gtk-greeter)))
+ (and (or (symbol? value) (string? value))
+ (string-contains (format #f "~a" value) "greeter")))
(define (serialize-greeter-session name value)
(format #f "~a=~a~%" name value))
(define-maybe greeter-session)
-(define-maybe string)
-
;;; Note: all the fields except for the seat name should be 'maybe's, since
;;; the real default value is set by the %lightdm-seat-default define later,
;;; and this avoids repeating ourselves in the serialized configuration file.
@@ -291,22 +383,6 @@ (define-configuration lightdm-seat-configuration
(list-of-strings '())
"Extra configuration values to append to the seat configuration section."))
-(define (greeter-session->greater-configuration-pred identifier)
- "Return the predicate to check if a configuration is of the type specifying
-a greeter identified by IDENTIFIER."
- (match identifier
- ;; Note: register any new greeter identifier here.
- ('lightdm-gtk-greeter
- lightdm-gtk-greeter-configuration?)))
-
-(define (greeter-configuration->greeter-session config)
- "Given CONFIG, a greeter configuration object, return its identifier,
-a symbol."
- (let ((suffix "-configuration")
- (greeter-conf-name (config->name config)))
- (string->symbol (string-drop-right (symbol->string greeter-conf-name)
- (string-length suffix)))))
-
(define list-of-seat-configurations?
(list-of lightdm-seat-configuration?))
@@ -316,20 +392,17 @@ (define list-of-seat-configurations?
;;;
(define (greeter-configuration? config)
- (or (lightdm-gtk-greeter-configuration? config)
- ;; Note: register any new greeter configuration here.
- ))
+ ((record-predicate (struct-vtable config)) config))
(define (list-of-greeter-configurations? greeter-configs)
(and ((list-of greeter-configuration?) greeter-configs)
;; Greeter configurations must also not be provided more than once.
- (let* ((types (map (compose record-type-name struct-vtable)
- greeter-configs))
- (dupes (filter (lambda (type)
- (< 1 (count (cut eq? type <>) types)))
- types)))
+ (let* ((conf-names (map greeter-configuration->conf-name greeter-configs))
+ (dupes (filter (lambda (conf-name)
+ (< 1 (count (cut eq? conf-name <>) conf-names)))
+ conf-names)))
(unless (null? dupes)
- (leave (G_ "duplicate greeter configurations: ~a~%") dupes)))))
+ (leave (G_ "Duplicate greeter configurations: ~a~%") dupes)))))
(define-configuration/no-serialization lightdm-configuration
(lightdm
@@ -347,7 +420,9 @@ (define-configuration/no-serialization lightdm-configuration
start script. It can be refined per seat via the @code{xserver-command} of
the @code{<lightdm-seat-configuration>} record, if desired.")
(greeters
- (list-of-greeter-configurations (list (lightdm-gtk-greeter-configuration)))
+ (list-of-greeter-configurations
+ (list (lightdm-gtk-greeter-configuration)
+ (lightdm-greeter-general-configuration)))
"The LightDM greeter configurations specifying the greeters to use.")
(seats
(list-of-seat-configurations (list (lightdm-seat-configuration
@@ -417,8 +492,11 @@ (define (validate-lightdm-configuration config)
(missing-greeters
(filter-map
(lambda (id)
- (define pred (greeter-session->greater-configuration-pred id))
- (if (find pred greeter-configurations)
+ (if (find (lambda (greeter-config)
+ (let* ((id (format #f "~a" id))
+ (name (greeter-configuration->session-name greeter-config)))
+ (equal? id name)))
+ greeter-configurations)
#f ;happy path
id))
greeter-sessions)))
@@ -428,10 +506,10 @@ (define pred (greeter-session->greater-configuration-pred id))
(define (lightdm-configuration-file config)
(match-record config <lightdm-configuration>
- (xorg-configuration seats
- xdmcp? xdmcp-listen-address
- vnc-server? vnc-server-command vnc-server-listen-address vnc-server-port
- extra-config)
+ (xorg-configuration
+ seats xdmcp? xdmcp-listen-address
+ vnc-server? vnc-server-command vnc-server-listen-address vnc-server-port
+ extra-config)
(apply
mixed-text-file
"lightdm.conf" "
@@ -470,22 +548,22 @@ (define (lightdm-configuration-file config)
# Seat configuration.
#
"
- (map (lambda (seat)
- ;; This complication exists to propagate a default value for
- ;; the 'xserver-command' field of the seats. Having a
- ;; 'xorg-configuration' field at the root of the
- ;; lightdm-configuration enables the use of
- ;; 'set-xorg-configuration' and can be more convenient.
- (let ((seat* (if (maybe-value-set?
- (lightdm-seat-configuration-xserver-command seat))
- seat
- (lightdm-seat-configuration
- (inherit seat)
- (xserver-command (xorg-start-command
- xorg-configuration))))))
- (serialize-configuration seat*
- lightdm-seat-configuration-fields)))
- seats))))
+ (map (lambda (seat)
+ ;; This complication exists to propagate a default value for
+ ;; the 'xserver-command' field of the seats. Having a
+ ;; 'xorg-configuration' field at the root of the
+ ;; lightdm-configuration enables the use of
+ ;; 'set-xorg-configuration' and can be more convenient.
+ (let ((seat* (if (maybe-value-set?
+ (lightdm-seat-configuration-xserver-command seat))
+ seat
+ (lightdm-seat-configuration
+ (inherit seat)
+ (xserver-command (xorg-start-command
+ xorg-configuration))))))
+ (serialize-configuration seat*
+ lightdm-seat-configuration-fields)))
+ seats))))
(define (lightdm-configuration-directory config)
"Return a directory containing the serialized lightdm configuration
@@ -495,7 +573,8 @@ (define (lightdm-configuration-directory config)
(map (lambda (g)
`(,(greeter-configuration->conf-name g)
,(greeter-configuration->file g)))
- (lightdm-configuration-greeters config)))))
+ (filter greeter-configuration-valid?
+ (lightdm-configuration-greeters config))))))
(define %lightdm-accounts
(list (user-group (name "lightdm") (system? #t))
@@ -676,4 +755,5 @@ (define lightdm-service-type
(define (generate-doc)
(configuration->documentation 'lightdm-configuration)
(configuration->documentation 'lightdm-gtk-greeter-configuration)
+ (configuration->documentation 'lightdm-greeter-general-configuration)
(configuration->documentation 'lightdm-seat-configuration))
--
2.46.0
tumashu@HIDDEN, tumashu@HIDDEN, guix-patches@HIDDEN:bug#75048; Package guix-patches.
Full text available.Received: (at 75048) by debbugs.gnu.org; 30 Dec 2024 01:46:40 +0000 From debbugs-submit-bounces <at> debbugs.gnu.org Sun Dec 29 20:46:40 2024 Received: from localhost ([127.0.0.1]:56715 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from <debbugs-submit-bounces <at> debbugs.gnu.org>) id 1tS4rg-00015q-9G for submit <at> debbugs.gnu.org; Sun, 29 Dec 2024 20:46:40 -0500 Received: from m16.mail.163.com ([117.135.210.2]:59994) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from <tumashu@HIDDEN>) id 1tS4ra-00015Q-Qv; Sun, 29 Dec 2024 20:46:38 -0500 DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=163.com; s=s110527; h=From:Subject:Date:Message-ID:MIME-Version: Content-Type; bh=xsPg7xi/hMFJlSPGtBW4UeUWDpgyX8Gz4OrOSR0LTf8=; b=EWhA9rTvF3JY86Rdo2vqtgJNq3qHOvNOwSogLM7XPh90qKy2Y9Ytw9aHY9viML P4DGUQK5ERvtccxEFVRDVKEbXVIydvHk2t/qN8aRgIk0kOQNRdnsKNV+vB8WQiNz NB0b07T323R6npiZ/PuleB6427UoKIr02u/cKPGXgKFdo= Received: from Tumashu (unknown []) by gzsmtp4 (Coremail) with SMTP id PygvCgD3vxFz+3FnY14qDA--.9594S2; Mon, 30 Dec 2024 09:46:27 +0800 (CST) From: Feng Shu <tumashu@HIDDEN> To: 75043 <at> debbugs.gnu.org, 75044 <at> debbugs.gnu.org, 75048 <at> debbugs.gnu.org Subject: Please review this patch. Date: Mon, 30 Dec 2024 09:46:27 +0800 Message-ID: <87ttamhrik.fsf@HIDDEN> User-Agent: Gnus/5.13 (Gnus v5.13) MIME-Version: 1.0 Content-Type: text/plain X-CM-TRANSID: PygvCgD3vxFz+3FnY14qDA--.9594S2 X-Coremail-Antispam: 1Uf129KBjDUn29KB7ZKAUJUUUUU529EdanIXcx71UUUUU7v73 VFW2AGmfu7bjvjm3AaLaJ3UbIYCTnIWIevJa73UjIFyTuYvjxUOYFCDUUUU X-Originating-IP: [218.92.14.78] X-CM-SenderInfo: 5wxpt2lkx6il2tof0z/1tbiERXF1Gdx+vMRIgAAs5 X-Spam-Score: 0.0 (/) X-Debbugs-Envelope-To: 75048 X-BeenThere: debbugs-submit <at> debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: <debbugs-submit.debbugs.gnu.org> List-Unsubscribe: <https://debbugs.gnu.org/cgi-bin/mailman/options/debbugs-submit>, <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=unsubscribe> List-Archive: <https://debbugs.gnu.org/cgi-bin/mailman/private/debbugs-submit/> List-Post: <mailto:debbugs-submit <at> debbugs.gnu.org> List-Help: <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=help> List-Subscribe: <https://debbugs.gnu.org/cgi-bin/mailman/listinfo/debbugs-submit>, <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=subscribe> Errors-To: debbugs-submit-bounces <at> debbugs.gnu.org Sender: "Debbugs-submit" <debbugs-submit-bounces <at> debbugs.gnu.org> X-Spam-Score: -1.0 (-) Please review this patch, thanks. --
guix-patches@HIDDEN:bug#75048; Package guix-patches.
Full text available.
Received: (at 75048) by debbugs.gnu.org; 30 Dec 2024 00:34:46 +0000
From debbugs-submit-bounces <at> debbugs.gnu.org Sun Dec 29 19:34:46 2024
Received: from localhost ([127.0.0.1]:56646 helo=debbugs.gnu.org)
by debbugs.gnu.org with esmtp (Exim 4.84_2)
(envelope-from <debbugs-submit-bounces <at> debbugs.gnu.org>)
id 1tS3k4-0006La-No
for submit <at> debbugs.gnu.org; Sun, 29 Dec 2024 19:34:46 -0500
Received: from m16.mail.163.com ([220.197.31.4]:35978)
by debbugs.gnu.org with esmtp (Exim 4.84_2)
(envelope-from <tumashu@HIDDEN>) id 1tS3k0-0006LP-0U
for 75048 <at> debbugs.gnu.org; Sun, 29 Dec 2024 19:34:43 -0500
DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=163.com;
s=s110527; h=From:Subject:Date:Message-ID:MIME-Version; bh=8/VjO
4CTb/9towwybqIADTGBXYsKXYrCJuf+BOHwau4=; b=XTmhssGw3pyj5LPhARczr
rMwPqVKu2vY9eZJhzZylVIw4FWowEbefA/9Zv6Ot0kKcTwxDThmQuoucCbViB+za
wUARmWYVMwQMJVWnPegyOwEhnF5fr0AQGgAtT2MVtrF755FYelAqpEv1/3AO5YaR
TeY3nRMTBiYUfFRXV1DS6w=
Received: from localhost.localdomain (unknown [])
by gzga-smtp-mtada-g1-1 (Coremail) with SMTP id
_____wD3f6eb6nFnZoNzCg--.60273S2;
Mon, 30 Dec 2024 08:34:35 +0800 (CST)
From: tumashu@HIDDEN
To: 75048 <at> debbugs.gnu.org
Subject: [PATCH v6] Add lightdm-greeter-general-configuration and do not hard
code config type name everywhere.
Date: Mon, 30 Dec 2024 08:34:20 +0800
Message-ID: <20241230003424.4417-1-tumashu@HIDDEN>
X-Mailer: git-send-email 2.45.2
MIME-Version: 1.0
X-Debbugs-Cc: Feng Shu <tumashu@HIDDEN>, tumashu@HIDDEN
Content-Transfer-Encoding: 8bit
X-CM-TRANSID: _____wD3f6eb6nFnZoNzCg--.60273S2
X-Coremail-Antispam: 1Uf129KBjvAXoWfZF4rCFyDWF43GF4ruF1xKrg_yoW8tFW7Xo
Z3ZFW7Gr47Cr17WFnayr1fCr47Jryv9r48Zr18JryUAw1vqF43Ja4Yvay8ZF42kr4jkrn8
Gr95u39xAFWqyF4rn29KB7ZKAUJUUUU8529EdanIXcx71UUUUU7v73VFW2AGmfu7bjvjm3
AaLaJ3UbIYCTnIWIevJa73UjIFyTuYvjTRA3kZDUUUU
X-Originating-IP: [218.92.14.78]
X-CM-SenderInfo: 5wxpt2lkx6il2tof0z/1tbiYA3F1Gdx48h4RQABs9
X-Spam-Score: 0.0 (/)
X-Debbugs-Envelope-To: 75048
Cc: Feng Shu <tumashu@HIDDEN>
X-BeenThere: debbugs-submit <at> debbugs.gnu.org
X-Mailman-Version: 2.1.18
Precedence: list
List-Id: <debbugs-submit.debbugs.gnu.org>
List-Unsubscribe: <https://debbugs.gnu.org/cgi-bin/mailman/options/debbugs-submit>,
<mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=unsubscribe>
List-Archive: <https://debbugs.gnu.org/cgi-bin/mailman/private/debbugs-submit/>
List-Post: <mailto:debbugs-submit <at> debbugs.gnu.org>
List-Help: <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=help>
List-Subscribe: <https://debbugs.gnu.org/cgi-bin/mailman/listinfo/debbugs-submit>,
<mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=subscribe>
Errors-To: debbugs-submit-bounces <at> debbugs.gnu.org
Sender: "Debbugs-submit" <debbugs-submit-bounces <at> debbugs.gnu.org>
X-Spam-Score: -1.0 (-)
From: Feng Shu <tumashu@HIDDEN>
* gnu/services/lightdm.scm (gnu): Use (ice-9 local-eval), export new option variables.
(local-eval-environment?): New variable.
(string): Move.
(lightdm-gtk-greeter-configuration): Add local-eval-environment,
greeter-session-name, greeter-package, greeter-config-name fields.
(lightdm-greeter-general-configuration): New variable.
(strip-record-type-name-brackets): Return string instead symbol.
(config->type-name): Rename from config->name.
(greeter-configuration-field): New function.
(greeter-configuration->greeter-fields): Do not hard code greeter configuation name.
(greeter-configuration->packages): Do not hard code greeter configuation name.
(greeter-configuration->conf-name): Improve.
(greeter-configuration->session-name): New variable.
(greeter-configuration->file): Call different function based config type.
(greeter-configuration->file/lightdm-gtk-greeter-configuration)
(greeter-configuration->file/lightdm-greeter-general-configuration): New functions.
(greeter-configuration-valid?): New function.
(greeter-session?): Do not hard code greeter configuation name.
(greeter-session->greater-configuration-pred)
(greeter-configuration->greeter-session): Removed.
(greeter-configuration?): Do not hard code greeter configuation name.
(lightdm-configuration): Add lightdm-greeter-general-configuration.
(validate-lightdm-configuration): Do not use greeter-session->greater-configuration-pred.
(generate-doc): Handle lightdm-greeter-general-configuration.
* doc/guix.texi (X Window): Improve lightdm-gtk-greeter-configuration options
doc, Add lightdm-greeter-general-configuration,
Change-Id: Iae22cd641454c86280e88d6986594ad0c8f4c490
---
doc/guix.texi | 94 +++++++++++++++-
gnu/services/lightdm.scm | 225 +++++++++++++++++++++++++++------------
2 files changed, 250 insertions(+), 69 deletions(-)
diff --git a/doc/guix.texi b/doc/guix.texi
index 31deb5b003..e1f1fee68b 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -23802,8 +23802,7 @@ In its most basic form, it can be used simply as:
(service lightdm-service-type)
@end lisp
-A more elaborate example making use of the VNC capabilities and enabling
-more features and verbose logs could look like:
+Two more elaborate examples look like below:
@lisp
(service lightdm-service-type
@@ -23819,6 +23818,38 @@ more features and verbose logs could look like:
(name "*")
(user-session "ratpoison"))))))
@end lisp
+
+@lisp
+(service lightdm-service-type
+ (lightdm-configuration
+ (greeters
+ (list (lightdm-greeter-general-configuration
+ (greeter-package lightdm-mini-greeter)
+ (greeter-session-name "lightdm-mini-greeter")
+ (greeter-config-name "lightdm-mini-greeter.conf")
+ (config (list "[greeter]"
+ "user = guest")))
+ (lightdm-gtk-greeter-configuration
+ (extra-config
+ (list "font-name = San 10"
+ "xft-dpi = 140"
+ "clock-format = %Y-%m-%d %H:%M"
+ ;; We need to use "~~" to generate a tilde, for
+ ;; extra-config sting will be handle as
+ ;; control-string of format function.
+ "indicators = ~~host;~~spacer;~~session;~~a11y;~~clock;~~power")))))
+ (seats
+ (list (lightdm-seat-configuration
+ (name "*")
+ (greeter-session 'lightdm-mini-greeter))))
+ (xorg-configuration
+ (xorg-configuration
+ (server-arguments
+ (append %default-xorg-server-arguments
+ '("-dpi" "140")))))))
+@end lisp
+
+
@end defvar
@c The LightDM service documentation can be auto-generated via the
@@ -23903,8 +23934,21 @@ Extra configuration values to append to the LightDM configuration file.
Available @code{lightdm-gtk-greeter-configuration} fields are:
@table @asis
+@item @code{local-eval-environment} (default: @code{(the-environment)}) (type: local-eval-environment)
+Recode the environment where lightdm-gtk-greeter-configuration is defined.
+
@item @code{lightdm-gtk-greeter} (default: @code{lightdm-gtk-greeter}) (type: file-like)
-The lightdm-gtk-greeter package to use.
+The lightdm-gtk-greeter package to use, this option is keeped for
+compatibility, use greeter-package instead.
+
+@item @code{greeter-package} (default: @code{lightdm-gtk-greeter}) (type: file-like)
+The greeter package to use.
+
+@item @code{greeter-session-name} (default: @code{lightdm-gtk-greeter}) (type: string)
+The session name used in lightdm.conf.
+
+@item @code{greeter-config-name} (default: @code{lightdm-gtk-greeter.conf}) (type: string)
+The greeter config file name in /etc/lightdm directory.
@item @code{assets} (default: @code{(adwaita-icon-theme gnome-themes-extra hicolor-icon-theme)}) (type: list-of-file-likes)
The list of packages complementing the greeter, such as package
@@ -23948,6 +23992,50 @@ configuration file.
@c %end of fragment
@c %start of fragment
+@deftp {Data Type} lightdm-greeter-general-configuration
+
+@code{lightdm-greeter-general-configuration} support all text config
+greeters which have no build-in configuration type like
+@code{lightdm-gtk-greeter-configuration}, such as lightdm-mini-greeter,
+for example:
+
+@lisp
+(lightdm-greeter-general-configuration
+ (greeter-package lightdm-mini-greeter)
+ (greeter-session-name "lightdm-mini-greeter")
+ (greeter-config-name "lightdm-mini-greeter.conf")
+ (config (list "[greeter]"
+ "user = guest")))
+@end lisp
+
+Available @code{lightdm-greeter-general-configuration} fields are:
+
+@table @asis
+@item @code{local-eval-environment} (default: @code{(the-environment)}) (type: local-eval-environment)
+Recode the environment where lightdm-greeter-general-configuration is defined.
+
+@item @code{greeter-package} (type: maybe-file-like)
+The greeter package to use.
+
+@item @code{greeter-session-name} (type: maybe-string)
+The session name used in lightdm.conf.
+
+@item @code{greeter-config-name} (type: maybe-string)
+The greeter config file name in /etc/lightdm directory.
+
+@item @code{assets} (default: @code{(adwaita-icon-theme gnome-themes-extra hicolor-icon-theme)}) (type: list-of-file-likes)
+The list of packages complementing the greeter, such as package
+providing icon themes.
+
+@item @code{config} (default: @code{'()}) (type: list-of-strings)
+Configuration values of the LightDM Greeter configuration file.
+
+@end table
+@end deftp
+
+@c %end of fragment
+@c %start of fragment
+
@deftp {Data Type} lightdm-seat-configuration
Available @code{lightdm-seat-configuration} fields are:
diff --git a/gnu/services/lightdm.scm b/gnu/services/lightdm.scm
index 191cb5635b..44858fae70 100644
--- a/gnu/services/lightdm.scm
+++ b/gnu/services/lightdm.scm
@@ -39,6 +39,7 @@ (define-module (gnu services lightdm)
#:use-module (guix i18n)
#:use-module (guix records)
#:use-module (ice-9 format)
+ #:use-module (ice-9 local-eval)
#:use-module (ice-9 match)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-26)
@@ -56,7 +57,10 @@ (define-module (gnu services lightdm)
lightdm-gtk-greeter-configuration
lightdm-gtk-greeter-configuration?
lightdm-gtk-greeter-configuration-lightdm-gtk-greeter
+ lightdm-gtk-greeter-configuration-greeter-package
lightdm-gtk-greeter-configuration-assets
+ lightdm-gtk-greeter-configuration-greeter-config-name
+ lightdm-gtk-greeter-configuration-greeter-session-name
lightdm-gtk-greeter-configuration-theme-name
lightdm-gtk-greeter-configuration-icon-theme-name
lightdm-gtk-greeter-configuration-cursor-theme-name
@@ -66,6 +70,14 @@ (define-module (gnu services lightdm)
lightdm-gtk-greeter-configuration-reader
lightdm-gtk-greeter-configuration-extra-config
+ lightdm-greeter-general-configuration
+ lightdm-greeter-general-configuration?
+ lightdm-greeter-general-configuration-greeter-package
+ lightdm-greeter-general-configuration-assets
+ lightdm-greeter-general-configuration-greeter-config-name
+ lightdm-greeter-general-configuration-greeter-session-name
+ lightdm-greeter-general-configuration-config
+
lightdm-configuration
lightdm-configuration?
lightdm-configuration-lightdm
@@ -87,6 +99,9 @@ (define-module (gnu services lightdm)
;;; Greeters.
;;;
+(define (local-eval-environment? value)
+ #t)
+
(define list-of-file-likes?
(list-of file-like?))
@@ -117,6 +132,8 @@ (define (serialize-file-like name value)
(define (serialize-list-of-a11y-states name value)
(format #f "~a=~a~%" name (string-join (map symbol->string value) ";")))
+(define-maybe string)
+
(define (serialize-string name value)
(format #f "~a=~a~%" name value))
@@ -127,9 +144,21 @@ (define (serialize-list-of-strings _ value)
(string-join value "\n"))
(define-configuration lightdm-gtk-greeter-configuration
+ (local-eval-environment
+ (local-eval-environment (the-environment))
+ "Recode the environment where lightdm-gtk-greeter-configuration is defined."
+ empty-serializer)
+ (greeter-session-name
+ (string "lightdm-gtk-greeter")
+ "Session name used in lightdm.conf"
+ empty-serializer)
(lightdm-gtk-greeter
+ maybe-file-like
+ "Keep it for compatibility, use greeter-package field instead."
+ empty-serializer)
+ (greeter-package
(file-like lightdm-gtk-greeter)
- "The lightdm-gtk-greeter package to use."
+ "The greeter package to use."
empty-serializer)
(assets
(list-of-file-likes (list adwaita-icon-theme
@@ -140,6 +169,10 @@ (define-configuration lightdm-gtk-greeter-configuration
"The list of packages complementing the greeter, such as package providing
icon themes."
empty-serializer)
+ (greeter-config-name
+ (string "lightdm-gtk-greeter.conf")
+ "Greeter config file name in /etc/lightdm directory."
+ empty-serializer)
(theme-name
(string "Adwaita")
"The name of the theme to use.")
@@ -176,34 +209,81 @@ (define-configuration lightdm-gtk-greeter-configuration
"Extra configuration values to append to the LightDM GTK Greeter
configuration file."))
+(define-configuration lightdm-greeter-general-configuration
+ (local-eval-environment
+ (local-eval-environment (the-environment))
+ "Recode the environment where lightdm-greeter-general-configuration is defined."
+ empty-serializer)
+ (greeter-package
+ maybe-file-like
+ "The greeter package to use."
+ empty-serializer)
+ (assets
+ (list-of-file-likes (list adwaita-icon-theme
+ gnome-themes-extra
+ ;; FIXME: hicolor-icon-theme should be in the
+ ;; packages of the desktop templates.
+ hicolor-icon-theme))
+ "The list of packages complementing the greeter, such as package providing
+icon themes."
+ empty-serializer)
+ (greeter-config-name
+ maybe-string
+ "Greeter config file name in /etc/lightdm directory."
+ empty-serializer)
+ (greeter-session-name
+ maybe-string
+ "Session name used in lightdm.conf"
+ empty-serializer)
+ (config
+ (list-of-strings '())
+ "Configuration values of the LightDM Greeter configuration file."))
+
(define (strip-record-type-name-brackets name)
"Remove the '<' and '>' brackets from NAME, a symbol."
(let ((name (symbol->string name)))
(if (and (string-prefix? "<" name)
(string-suffix? ">" name))
- (string->symbol (string-drop (string-drop-right name 1) 1))
+ (string-drop (string-drop-right name 1) 1)
(error "unexpected record type name" name))))
-(define (config->name config)
- "Return the constructor name (a symbol) from CONFIG."
+(define (config->type-name config)
+ "Return the type name of CONFIG."
(strip-record-type-name-brackets
(record-type-name (struct-vtable config))))
+(define (greeter-configuration-field config field)
+ "Return field value of config."
+ (let ((rtd (struct-vtable config)))
+ ((record-accessor rtd field) config)))
+
+(define (greeter-configuration->session-name config)
+ "Return the session name of CONFIG, a greeter configuration."
+ (greeter-configuration-field config 'greeter-session-name))
+
(define (greeter-configuration->greeter-fields config)
"Return the fields of CONFIG, a greeter configuration."
- (match config
- ;; Note: register any new greeter configuration here.
- ((? lightdm-gtk-greeter-configuration?)
- lightdm-gtk-greeter-configuration-fields)))
+ (let* ((type-name (config->type-name config))
+ (variable (string->symbol (string-append type-name "-fields")))
+ (eval-env (greeter-configuration-field config 'local-eval-environment)))
+ (local-eval variable eval-env)))
(define (greeter-configuration->packages config)
"Return the list of greeter packages, including assets, used by CONFIG, a
greeter configuration."
- (match config
- ;; Note: register any new greeter configuration here.
- ((? lightdm-gtk-greeter-configuration?)
- (cons (lightdm-gtk-greeter-configuration-lightdm-gtk-greeter config)
- (lightdm-gtk-greeter-configuration-assets config)))))
+ (filter file-like?
+ (cons (greeter-configuration->greeter-package config)
+ (greeter-configuration-field config 'assets))))
+
+(define (greeter-configuration->greeter-package config)
+ "Return greeter package used by CONFIG, a greeter configuration."
+ (let ((type-name (config->type-name config))
+ (pkg1 (greeter-configuration-field config 'greeter-package)))
+ (if (eq? type-name "lightdm-gtk-greeter-configuration")
+ ;; Handle lightdm-gtk-greeter field for keeping it for compatibility.
+ (let ((pkg2 (greeter-configuration-field config 'lightdm-gtk-greeter)))
+ (if (file-like? pkg2) pkg2 pkg1))
+ pkg1)))
;;; TODO: Implement directly in (gnu services configuration), perhaps by
;;; making the FIELDS argument optional.
@@ -215,11 +295,19 @@ (define fields (greeter-configuration->greeter-fields config))
(define (greeter-configuration->conf-name config)
"Return the file name of CONFIG, a greeter configuration."
- (format #f "~a.conf" (greeter-configuration->greeter-session config)))
+ (greeter-configuration-field config 'greeter-config-name))
(define (greeter-configuration->file config)
"Serialize CONFIG into a file under the output directory, so that it can be
easily added to XDG_CONF_DIRS."
+ (let* ((type-name (config->type-name config))
+ (func-name (string->symbol
+ (string-append
+ "greeter-configuration->file/" type-name)))
+ (eval-env (greeter-configuration-field config 'local-eval-environment)))
+ (local-eval `(,func-name ,config) eval-env)))
+
+(define (greeter-configuration->file/lightdm-gtk-greeter-configuration config)
(computed-file
(greeter-configuration->conf-name config)
#~(begin
@@ -229,6 +317,23 @@ (define (greeter-configuration->file config)
"[greeter]\n"
#$(serialize-configuration* config))))))))
+(define (greeter-configuration->file/lightdm-greeter-general-configuration config)
+ (computed-file
+ (greeter-configuration->conf-name config)
+ #~(begin
+ (call-with-output-file #$output
+ (lambda (port)
+ (format port #$(serialize-configuration* config)))))))
+
+(define (greeter-configuration-valid? config)
+ "Check greeter-configuration CONFIG valid or not."
+ (let ((conf-name (greeter-configuration->conf-name config))
+ (session-name (greeter-configuration->session-name config)))
+ (and (string? conf-name)
+ (string? session-name)
+ (> (string-length conf-name) 0)
+ (> (string-length session-name) 0))))
+
;;;
;;; Seats.
@@ -248,15 +353,14 @@ (define (serialize-seat-type name value)
(define-maybe seat-type)
(define (greeter-session? value)
- (memq value '(lightdm-gtk-greeter)))
+ (and (or (symbol? value) (string? value))
+ (string-contains (format #f "~a" value) "greeter")))
(define (serialize-greeter-session name value)
(format #f "~a=~a~%" name value))
(define-maybe greeter-session)
-(define-maybe string)
-
;;; Note: all the fields except for the seat name should be 'maybe's, since
;;; the real default value is set by the %lightdm-seat-default define later,
;;; and this avoids repeating ourselves in the serialized configuration file.
@@ -291,22 +395,6 @@ (define-configuration lightdm-seat-configuration
(list-of-strings '())
"Extra configuration values to append to the seat configuration section."))
-(define (greeter-session->greater-configuration-pred identifier)
- "Return the predicate to check if a configuration is of the type specifying
-a greeter identified by IDENTIFIER."
- (match identifier
- ;; Note: register any new greeter identifier here.
- ('lightdm-gtk-greeter
- lightdm-gtk-greeter-configuration?)))
-
-(define (greeter-configuration->greeter-session config)
- "Given CONFIG, a greeter configuration object, return its identifier,
-a symbol."
- (let ((suffix "-configuration")
- (greeter-conf-name (config->name config)))
- (string->symbol (string-drop-right (symbol->string greeter-conf-name)
- (string-length suffix)))))
-
(define list-of-seat-configurations?
(list-of lightdm-seat-configuration?))
@@ -316,20 +404,17 @@ (define list-of-seat-configurations?
;;;
(define (greeter-configuration? config)
- (or (lightdm-gtk-greeter-configuration? config)
- ;; Note: register any new greeter configuration here.
- ))
+ ((record-predicate (struct-vtable config)) config))
(define (list-of-greeter-configurations? greeter-configs)
(and ((list-of greeter-configuration?) greeter-configs)
;; Greeter configurations must also not be provided more than once.
- (let* ((types (map (compose record-type-name struct-vtable)
- greeter-configs))
- (dupes (filter (lambda (type)
- (< 1 (count (cut eq? type <>) types)))
- types)))
+ (let* ((conf-names (map greeter-configuration->conf-name greeter-configs))
+ (dupes (filter (lambda (conf-name)
+ (< 1 (count (cut eq? conf-name <>) conf-names)))
+ conf-names)))
(unless (null? dupes)
- (leave (G_ "duplicate greeter configurations: ~a~%") dupes)))))
+ (leave (G_ "Duplicate greeter configurations: ~a~%") dupes)))))
(define-configuration/no-serialization lightdm-configuration
(lightdm
@@ -347,7 +432,9 @@ (define-configuration/no-serialization lightdm-configuration
start script. It can be refined per seat via the @code{xserver-command} of
the @code{<lightdm-seat-configuration>} record, if desired.")
(greeters
- (list-of-greeter-configurations (list (lightdm-gtk-greeter-configuration)))
+ (list-of-greeter-configurations
+ (list (lightdm-gtk-greeter-configuration)
+ (lightdm-greeter-general-configuration)))
"The LightDM greeter configurations specifying the greeters to use.")
(seats
(list-of-seat-configurations (list (lightdm-seat-configuration
@@ -417,8 +504,11 @@ (define (validate-lightdm-configuration config)
(missing-greeters
(filter-map
(lambda (id)
- (define pred (greeter-session->greater-configuration-pred id))
- (if (find pred greeter-configurations)
+ (if (find (lambda (greeter-config)
+ (let* ((id (format #f "~a" id))
+ (name (greeter-configuration->session-name greeter-config)))
+ (equal? id name)))
+ greeter-configurations)
#f ;happy path
id))
greeter-sessions)))
@@ -428,10 +518,11 @@ (define pred (greeter-session->greater-configuration-pred id))
(define (lightdm-configuration-file config)
(match-record config <lightdm-configuration>
- (xorg-configuration seats
- xdmcp? xdmcp-listen-address
- vnc-server? vnc-server-command vnc-server-listen-address vnc-server-port
- extra-config)
+ (xorg-configuration
+ seats xdmcp? xdmcp-listen-address
+ vnc-server? vnc-server-command
+ vnc-server-listen-address vnc-server-port
+ extra-config)
(apply
mixed-text-file
"lightdm.conf" "
@@ -470,22 +561,22 @@ (define (lightdm-configuration-file config)
# Seat configuration.
#
"
- (map (lambda (seat)
- ;; This complication exists to propagate a default value for
- ;; the 'xserver-command' field of the seats. Having a
- ;; 'xorg-configuration' field at the root of the
- ;; lightdm-configuration enables the use of
- ;; 'set-xorg-configuration' and can be more convenient.
- (let ((seat* (if (maybe-value-set?
- (lightdm-seat-configuration-xserver-command seat))
- seat
- (lightdm-seat-configuration
- (inherit seat)
- (xserver-command (xorg-start-command
- xorg-configuration))))))
- (serialize-configuration seat*
- lightdm-seat-configuration-fields)))
- seats))))
+ (map (lambda (seat)
+ ;; This complication exists to propagate a default value for
+ ;; the 'xserver-command' field of the seats. Having a
+ ;; 'xorg-configuration' field at the root of the
+ ;; lightdm-configuration enables the use of
+ ;; 'set-xorg-configuration' and can be more convenient.
+ (let ((seat* (if (maybe-value-set?
+ (lightdm-seat-configuration-xserver-command seat))
+ seat
+ (lightdm-seat-configuration
+ (inherit seat)
+ (xserver-command (xorg-start-command
+ xorg-configuration))))))
+ (serialize-configuration seat*
+ lightdm-seat-configuration-fields)))
+ seats))))
(define (lightdm-configuration-directory config)
"Return a directory containing the serialized lightdm configuration
@@ -495,7 +586,8 @@ (define (lightdm-configuration-directory config)
(map (lambda (g)
`(,(greeter-configuration->conf-name g)
,(greeter-configuration->file g)))
- (lightdm-configuration-greeters config)))))
+ (filter greeter-configuration-valid?
+ (lightdm-configuration-greeters config))))))
(define %lightdm-accounts
(list (user-group (name "lightdm") (system? #t))
@@ -676,4 +768,5 @@ (define lightdm-service-type
(define (generate-doc)
(configuration->documentation 'lightdm-configuration)
(configuration->documentation 'lightdm-gtk-greeter-configuration)
+ (configuration->documentation 'lightdm-greeter-general-configuration)
(configuration->documentation 'lightdm-seat-configuration))
--
2.45.2
tumashu@HIDDEN, tumashu@HIDDEN, guix-patches@HIDDEN:bug#75048; Package guix-patches.
Full text available.
Received: (at 75048) by debbugs.gnu.org; 25 Dec 2024 06:03:46 +0000
From debbugs-submit-bounces <at> debbugs.gnu.org Wed Dec 25 01:03:46 2024
Received: from localhost ([127.0.0.1]:35918 helo=debbugs.gnu.org)
by debbugs.gnu.org with esmtp (Exim 4.84_2)
(envelope-from <debbugs-submit-bounces <at> debbugs.gnu.org>)
id 1tQKUj-0007sR-Dw
for submit <at> debbugs.gnu.org; Wed, 25 Dec 2024 01:03:46 -0500
Received: from m16.mail.163.com ([220.197.31.3]:57354)
by debbugs.gnu.org with esmtp (Exim 4.84_2)
(envelope-from <tumashu@HIDDEN>) id 1tQKUd-0007s4-Rh
for 75048 <at> debbugs.gnu.org; Wed, 25 Dec 2024 01:03:44 -0500
DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=163.com;
s=s110527; h=From:Subject:Date:Message-ID:MIME-Version; bh=eA/nH
m8TE+TdDb7+jt/rzmYItvELZ2erq8d0mkhVqwc=; b=mA32JUdz5xNGRm1VCNzfd
V0iLgGPMZQLgkW3F5Xe28/WRc5dXhoQgjJfd5JIzWQMZyZrLIu/GFYL7Bl4Rqi0q
nL+7+9UHnQiwwQ3BtEYFoiO+GKvEwc8+3SPDCe1W3XJwCnwK12DA3+pI2f1DzXnL
2owo09tbOt94ewZppv52tA=
Received: from localhost.localdomain (unknown [])
by gzga-smtp-mtada-g0-4 (Coremail) with SMTP id
_____wD3X70xoGtnfx8iBg--.17016S2;
Wed, 25 Dec 2024 14:03:30 +0800 (CST)
From: tumashu@HIDDEN
To: 75048 <at> debbugs.gnu.org
Subject: [PATCH v5] Add lightdm-greeter-general-configuration and do not hard
code config type name everywhere.
Date: Wed, 25 Dec 2024 14:03:15 +0800
Message-ID: <20241225060317.42053-1-tumashu@HIDDEN>
X-Mailer: git-send-email 2.45.2
MIME-Version: 1.0
X-Debbugs-Cc: Feng Shu <tumashu@HIDDEN>, tumashu@HIDDEN
Content-Transfer-Encoding: 8bit
X-CM-TRANSID: _____wD3X70xoGtnfx8iBg--.17016S2
X-Coremail-Antispam: 1Uf129KBjvAXoWfZF4rCFyDWF43GF4ruF1xKrg_yoW8tFW5to
Z3ZFW7Gr47Cr17WFnayr1fCr47Jryv9r48Zr18JryUAw1vqF43Ja4YvayUZF42kr4jkrn8
Gr95u39xAFWqyF4rn29KB7ZKAUJUUUU8529EdanIXcx71UUUUU7v73VFW2AGmfu7bjvjm3
AaLaJ3UbIYCTnIWIevJa73UjIFyTuYvjTRXdbbDUUUU
X-Originating-IP: [218.92.14.78]
X-CM-SenderInfo: 5wxpt2lkx6il2tof0z/1tbiERnA1GdrmGyrLwAAsg
X-Spam-Score: 0.0 (/)
X-Debbugs-Envelope-To: 75048
Cc: Feng Shu <tumashu@HIDDEN>
X-BeenThere: debbugs-submit <at> debbugs.gnu.org
X-Mailman-Version: 2.1.18
Precedence: list
List-Id: <debbugs-submit.debbugs.gnu.org>
List-Unsubscribe: <https://debbugs.gnu.org/cgi-bin/mailman/options/debbugs-submit>,
<mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=unsubscribe>
List-Archive: <https://debbugs.gnu.org/cgi-bin/mailman/private/debbugs-submit/>
List-Post: <mailto:debbugs-submit <at> debbugs.gnu.org>
List-Help: <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=help>
List-Subscribe: <https://debbugs.gnu.org/cgi-bin/mailman/listinfo/debbugs-submit>,
<mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=subscribe>
Errors-To: debbugs-submit-bounces <at> debbugs.gnu.org
Sender: "Debbugs-submit" <debbugs-submit-bounces <at> debbugs.gnu.org>
X-Spam-Score: -1.0 (-)
From: Feng Shu <tumashu@HIDDEN>
* gnu/services/lightdm.scm (gnu): Use (ice-9 local-eval), export new option variables.
(local-eval-environment?): New variable.
(string): Move.
(lightdm-gtk-greeter-configuration): Add local-eval-environment,
greeter-session-name, greeter-package, greeter-config-name fields.
(lightdm-greeter-general-configuration): New variable.
(strip-record-type-name-brackets): Return string instead symbol.
(config->type-name): Rename from config->name.
(greeter-configuration-field): New function.
(greeter-configuration->greeter-fields): Do not hard code greeter configuation name.
(greeter-configuration->packages): Do not hard code greeter configuation name.
(greeter-configuration->conf-name): Improve.
(greeter-configuration->session-name): New variable.
(greeter-configuration->file): Call different function based config type.
(greeter-configuration->file/lightdm-gtk-greeter-configuration)
(greeter-configuration->file/lightdm-greeter-general-configuration): New functions.
(greeter-configuration-valid?): New function.
(greeter-session?): Do not hard code greeter configuation name.
(greeter-session->greater-configuration-pred)
(greeter-configuration->greeter-session): Removed.
(greeter-configuration?): Do not hard code greeter configuation name.
(lightdm-configuration): Add lightdm-greeter-general-configuration.
(validate-lightdm-configuration): Do not use greeter-session->greater-configuration-pred.
(generate-doc): Handle lightdm-greeter-general-configuration.
* doc/guix.texi (X Window): Improve lightdm-gtk-greeter-configuration options
doc, Add lightdm-greeter-general-configuration,
Change-Id: Iae22cd641454c86280e88d6986594ad0c8f4c490
---
doc/guix.texi | 94 +++++++++++++++-
gnu/services/lightdm.scm | 225 +++++++++++++++++++++++++++------------
2 files changed, 250 insertions(+), 69 deletions(-)
diff --git a/doc/guix.texi b/doc/guix.texi
index 31deb5b003..e1f1fee68b 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -23802,8 +23802,7 @@ In its most basic form, it can be used simply as:
(service lightdm-service-type)
@end lisp
-A more elaborate example making use of the VNC capabilities and enabling
-more features and verbose logs could look like:
+Two more elaborate examples look like below:
@lisp
(service lightdm-service-type
@@ -23819,6 +23818,38 @@ more features and verbose logs could look like:
(name "*")
(user-session "ratpoison"))))))
@end lisp
+
+@lisp
+(service lightdm-service-type
+ (lightdm-configuration
+ (greeters
+ (list (lightdm-greeter-general-configuration
+ (greeter-package lightdm-mini-greeter)
+ (greeter-session-name "lightdm-mini-greeter")
+ (greeter-config-name "lightdm-mini-greeter.conf")
+ (config (list "[greeter]"
+ "user = guest")))
+ (lightdm-gtk-greeter-configuration
+ (extra-config
+ (list "font-name = San 10"
+ "xft-dpi = 140"
+ "clock-format = %Y-%m-%d %H:%M"
+ ;; We need to use "~~" to generate a tilde, for
+ ;; extra-config sting will be handle as
+ ;; control-string of format function.
+ "indicators = ~~host;~~spacer;~~session;~~a11y;~~clock;~~power")))))
+ (seats
+ (list (lightdm-seat-configuration
+ (name "*")
+ (greeter-session 'lightdm-mini-greeter))))
+ (xorg-configuration
+ (xorg-configuration
+ (server-arguments
+ (append %default-xorg-server-arguments
+ '("-dpi" "140")))))))
+@end lisp
+
+
@end defvar
@c The LightDM service documentation can be auto-generated via the
@@ -23903,8 +23934,21 @@ Extra configuration values to append to the LightDM configuration file.
Available @code{lightdm-gtk-greeter-configuration} fields are:
@table @asis
+@item @code{local-eval-environment} (default: @code{(the-environment)}) (type: local-eval-environment)
+Recode the environment where lightdm-gtk-greeter-configuration is defined.
+
@item @code{lightdm-gtk-greeter} (default: @code{lightdm-gtk-greeter}) (type: file-like)
-The lightdm-gtk-greeter package to use.
+The lightdm-gtk-greeter package to use, this option is keeped for
+compatibility, use greeter-package instead.
+
+@item @code{greeter-package} (default: @code{lightdm-gtk-greeter}) (type: file-like)
+The greeter package to use.
+
+@item @code{greeter-session-name} (default: @code{lightdm-gtk-greeter}) (type: string)
+The session name used in lightdm.conf.
+
+@item @code{greeter-config-name} (default: @code{lightdm-gtk-greeter.conf}) (type: string)
+The greeter config file name in /etc/lightdm directory.
@item @code{assets} (default: @code{(adwaita-icon-theme gnome-themes-extra hicolor-icon-theme)}) (type: list-of-file-likes)
The list of packages complementing the greeter, such as package
@@ -23948,6 +23992,50 @@ configuration file.
@c %end of fragment
@c %start of fragment
+@deftp {Data Type} lightdm-greeter-general-configuration
+
+@code{lightdm-greeter-general-configuration} support all text config
+greeters which have no build-in configuration type like
+@code{lightdm-gtk-greeter-configuration}, such as lightdm-mini-greeter,
+for example:
+
+@lisp
+(lightdm-greeter-general-configuration
+ (greeter-package lightdm-mini-greeter)
+ (greeter-session-name "lightdm-mini-greeter")
+ (greeter-config-name "lightdm-mini-greeter.conf")
+ (config (list "[greeter]"
+ "user = guest")))
+@end lisp
+
+Available @code{lightdm-greeter-general-configuration} fields are:
+
+@table @asis
+@item @code{local-eval-environment} (default: @code{(the-environment)}) (type: local-eval-environment)
+Recode the environment where lightdm-greeter-general-configuration is defined.
+
+@item @code{greeter-package} (type: maybe-file-like)
+The greeter package to use.
+
+@item @code{greeter-session-name} (type: maybe-string)
+The session name used in lightdm.conf.
+
+@item @code{greeter-config-name} (type: maybe-string)
+The greeter config file name in /etc/lightdm directory.
+
+@item @code{assets} (default: @code{(adwaita-icon-theme gnome-themes-extra hicolor-icon-theme)}) (type: list-of-file-likes)
+The list of packages complementing the greeter, such as package
+providing icon themes.
+
+@item @code{config} (default: @code{'()}) (type: list-of-strings)
+Configuration values of the LightDM Greeter configuration file.
+
+@end table
+@end deftp
+
+@c %end of fragment
+@c %start of fragment
+
@deftp {Data Type} lightdm-seat-configuration
Available @code{lightdm-seat-configuration} fields are:
diff --git a/gnu/services/lightdm.scm b/gnu/services/lightdm.scm
index 191cb5635b..e59a4ceb6e 100644
--- a/gnu/services/lightdm.scm
+++ b/gnu/services/lightdm.scm
@@ -39,6 +39,7 @@ (define-module (gnu services lightdm)
#:use-module (guix i18n)
#:use-module (guix records)
#:use-module (ice-9 format)
+ #:use-module (ice-9 local-eval)
#:use-module (ice-9 match)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-26)
@@ -56,7 +57,10 @@ (define-module (gnu services lightdm)
lightdm-gtk-greeter-configuration
lightdm-gtk-greeter-configuration?
lightdm-gtk-greeter-configuration-lightdm-gtk-greeter
+ lightdm-gtk-greeter-configuration-greeter-package
lightdm-gtk-greeter-configuration-assets
+ lightdm-gtk-greeter-configuration-greeter-config-name
+ lightdm-gtk-greeter-configuration-greeter-session-name
lightdm-gtk-greeter-configuration-theme-name
lightdm-gtk-greeter-configuration-icon-theme-name
lightdm-gtk-greeter-configuration-cursor-theme-name
@@ -66,6 +70,14 @@ (define-module (gnu services lightdm)
lightdm-gtk-greeter-configuration-reader
lightdm-gtk-greeter-configuration-extra-config
+ lightdm-greeter-general-configuration
+ lightdm-greeter-general-configuration?
+ lightdm-greeter-general-configuration-greeter-package
+ lightdm-greeter-general-configuration-assets
+ lightdm-greeter-general-configuration-greeter-config-name
+ lightdm-greeter-general-configuration-greeter-session-name
+ lightdm-greeter-general-configuration-config
+
lightdm-configuration
lightdm-configuration?
lightdm-configuration-lightdm
@@ -87,6 +99,9 @@ (define-module (gnu services lightdm)
;;; Greeters.
;;;
+(define (local-eval-environment? value)
+ #t)
+
(define list-of-file-likes?
(list-of file-like?))
@@ -117,6 +132,8 @@ (define (serialize-file-like name value)
(define (serialize-list-of-a11y-states name value)
(format #f "~a=~a~%" name (string-join (map symbol->string value) ";")))
+(define-maybe string)
+
(define (serialize-string name value)
(format #f "~a=~a~%" name value))
@@ -127,9 +144,21 @@ (define (serialize-list-of-strings _ value)
(string-join value "\n"))
(define-configuration lightdm-gtk-greeter-configuration
+ (local-eval-environment
+ (local-eval-environment (the-environment))
+ "Recode the environment where lightdm-gtk-greeter-configuration is defined."
+ empty-serializer)
+ (greeter-session-name
+ (string "lightdm-gtk-greeter")
+ "Session name used in lightdm.conf"
+ empty-serializer)
(lightdm-gtk-greeter
+ maybe-file-like
+ "Keep it for compatibility, use greeter-package field instead."
+ empty-serializer)
+ (greeter-package
(file-like lightdm-gtk-greeter)
- "The lightdm-gtk-greeter package to use."
+ "The greeter package to use."
empty-serializer)
(assets
(list-of-file-likes (list adwaita-icon-theme
@@ -140,6 +169,10 @@ (define-configuration lightdm-gtk-greeter-configuration
"The list of packages complementing the greeter, such as package providing
icon themes."
empty-serializer)
+ (greeter-config-name
+ (string "lightdm-gtk-greeter.conf")
+ "Greeter config file name in /etc/lightdm directory."
+ empty-serializer)
(theme-name
(string "Adwaita")
"The name of the theme to use.")
@@ -176,34 +209,81 @@ (define-configuration lightdm-gtk-greeter-configuration
"Extra configuration values to append to the LightDM GTK Greeter
configuration file."))
+(define-configuration lightdm-greeter-general-configuration
+ (local-eval-environment
+ (local-eval-environment (the-environment))
+ "Recode the environment where lightdm-greeter-general-configuration is defined."
+ empty-serializer)
+ (greeter-package
+ maybe-file-like
+ "The greeter package to use."
+ empty-serializer)
+ (assets
+ (list-of-file-likes (list adwaita-icon-theme
+ gnome-themes-extra
+ ;; FIXME: hicolor-icon-theme should be in the
+ ;; packages of the desktop templates.
+ hicolor-icon-theme))
+ "The list of packages complementing the greeter, such as package providing
+icon themes."
+ empty-serializer)
+ (greeter-config-name
+ maybe-string
+ "Greeter config file name in /etc/lightdm directory."
+ empty-serializer)
+ (greeter-session-name
+ maybe-string
+ "Session name used in lightdm.conf"
+ empty-serializer)
+ (config
+ (list-of-strings '())
+ "Configuration values of the LightDM Greeter configuration file."))
+
(define (strip-record-type-name-brackets name)
"Remove the '<' and '>' brackets from NAME, a symbol."
(let ((name (symbol->string name)))
(if (and (string-prefix? "<" name)
(string-suffix? ">" name))
- (string->symbol (string-drop (string-drop-right name 1) 1))
+ (string-drop (string-drop-right name 1) 1)
(error "unexpected record type name" name))))
-(define (config->name config)
- "Return the constructor name (a symbol) from CONFIG."
+(define (config->type-name config)
+ "Return the type name of CONFIG."
(strip-record-type-name-brackets
(record-type-name (struct-vtable config))))
+(define (greeter-configuration-field config field)
+ "Return field value of config."
+ (let ((rtd (struct-vtable config)))
+ ((record-accessor rtd field) config)))
+
+(define (greeter-configuration->session-name config)
+ "Return the session name of CONFIG, a greeter configuration."
+ (greeter-configuration-field config 'greeter-session-name))
+
(define (greeter-configuration->greeter-fields config)
"Return the fields of CONFIG, a greeter configuration."
- (match config
- ;; Note: register any new greeter configuration here.
- ((? lightdm-gtk-greeter-configuration?)
- lightdm-gtk-greeter-configuration-fields)))
+ (let* ((type-name (config->type-name config))
+ (variable (string->symbol (string-append type-name "-fields")))
+ (eval-env (greeter-configuration-field config 'local-eval-environment)))
+ (local-eval variable eval-env)))
(define (greeter-configuration->packages config)
"Return the list of greeter packages, including assets, used by CONFIG, a
greeter configuration."
- (match config
- ;; Note: register any new greeter configuration here.
- ((? lightdm-gtk-greeter-configuration?)
- (cons (lightdm-gtk-greeter-configuration-lightdm-gtk-greeter config)
- (lightdm-gtk-greeter-configuration-assets config)))))
+ (filter file-like?
+ (cons (greeter-configuration->greeter-package config)
+ (greeter-configuration-field config 'assets))))
+
+(define (greeter-configuration->greeter-package config)
+ "Return greeter package used by CONFIG, a greeter configuration."
+ (let ((type-name (config->type-name config))
+ (pkg1 (greeter-configuration-field config 'greeter-package)))
+ (if (eq? type-name "lightdm-gtk-greeter-configuration")
+ ;; Handle lightdm-gtk-greeter field for keeping it for compatibility.
+ (let ((pkg2 (greeter-configuration-field config 'lightdm-gtk-greeter)))
+ (if (file-like? pkg2) pkg2 pkg1))
+ pkg1)))
;;; TODO: Implement directly in (gnu services configuration), perhaps by
;;; making the FIELDS argument optional.
@@ -215,11 +295,19 @@ (define fields (greeter-configuration->greeter-fields config))
(define (greeter-configuration->conf-name config)
"Return the file name of CONFIG, a greeter configuration."
- (format #f "~a.conf" (greeter-configuration->greeter-session config)))
+ (greeter-configuration-field config 'greeter-config-name))
(define (greeter-configuration->file config)
"Serialize CONFIG into a file under the output directory, so that it can be
easily added to XDG_CONF_DIRS."
+ (let* ((type-name (config->type-name config))
+ (func-name (string->symbol
+ (string-append
+ "greeter-configuration->file/" type-name)))
+ (eval-env (greeter-configuration-field config 'local-eval-environment)))
+ (local-eval `(,func-name ,config) eval-env)))
+
+(define (greeter-configuration->file/lightdm-gtk-greeter-configuration config)
(computed-file
(greeter-configuration->conf-name config)
#~(begin
@@ -229,6 +317,23 @@ (define (greeter-configuration->file config)
"[greeter]\n"
#$(serialize-configuration* config))))))))
+(define (greeter-configuration->file/lightdm-greeter-general-configuration config)
+ (computed-file
+ (greeter-configuration->conf-name config)
+ #~(begin
+ (call-with-output-file #$output
+ (lambda (port)
+ (format port #$(serialize-configuration* config)))))))
+
+(define (greeter-configuration-valid? config)
+ "Check greeter-configuration CONFIG valid or not."
+ (let ((conf-name (greeter-configuration->conf-name config))
+ (session-name (greeter-configuration->session-name config)))
+ (and (string? conf-name)
+ (string? session-name)
+ (> (string-length conf-name) 0)
+ (> (string-length session-name) 0))))
+
;;;
;;; Seats.
@@ -248,15 +353,14 @@ (define (serialize-seat-type name value)
(define-maybe seat-type)
(define (greeter-session? value)
- (memq value '(lightdm-gtk-greeter)))
+ (and (symbol? value)
+ (string-contains (symbol->string value) "greeter")))
(define (serialize-greeter-session name value)
(format #f "~a=~a~%" name value))
(define-maybe greeter-session)
-(define-maybe string)
-
;;; Note: all the fields except for the seat name should be 'maybe's, since
;;; the real default value is set by the %lightdm-seat-default define later,
;;; and this avoids repeating ourselves in the serialized configuration file.
@@ -291,22 +395,6 @@ (define-configuration lightdm-seat-configuration
(list-of-strings '())
"Extra configuration values to append to the seat configuration section."))
-(define (greeter-session->greater-configuration-pred identifier)
- "Return the predicate to check if a configuration is of the type specifying
-a greeter identified by IDENTIFIER."
- (match identifier
- ;; Note: register any new greeter identifier here.
- ('lightdm-gtk-greeter
- lightdm-gtk-greeter-configuration?)))
-
-(define (greeter-configuration->greeter-session config)
- "Given CONFIG, a greeter configuration object, return its identifier,
-a symbol."
- (let ((suffix "-configuration")
- (greeter-conf-name (config->name config)))
- (string->symbol (string-drop-right (symbol->string greeter-conf-name)
- (string-length suffix)))))
-
(define list-of-seat-configurations?
(list-of lightdm-seat-configuration?))
@@ -316,20 +404,17 @@ (define list-of-seat-configurations?
;;;
(define (greeter-configuration? config)
- (or (lightdm-gtk-greeter-configuration? config)
- ;; Note: register any new greeter configuration here.
- ))
+ ((record-predicate (struct-vtable config)) config))
(define (list-of-greeter-configurations? greeter-configs)
(and ((list-of greeter-configuration?) greeter-configs)
;; Greeter configurations must also not be provided more than once.
- (let* ((types (map (compose record-type-name struct-vtable)
- greeter-configs))
- (dupes (filter (lambda (type)
- (< 1 (count (cut eq? type <>) types)))
- types)))
+ (let* ((conf-names (map greeter-configuration->conf-name greeter-configs))
+ (dupes (filter (lambda (conf-name)
+ (< 1 (count (cut eq? conf-name <>) conf-names)))
+ conf-names)))
(unless (null? dupes)
- (leave (G_ "duplicate greeter configurations: ~a~%") dupes)))))
+ (leave (G_ "Duplicate greeter configurations: ~a~%") dupes)))))
(define-configuration/no-serialization lightdm-configuration
(lightdm
@@ -347,7 +432,9 @@ (define-configuration/no-serialization lightdm-configuration
start script. It can be refined per seat via the @code{xserver-command} of
the @code{<lightdm-seat-configuration>} record, if desired.")
(greeters
- (list-of-greeter-configurations (list (lightdm-gtk-greeter-configuration)))
+ (list-of-greeter-configurations
+ (list (lightdm-gtk-greeter-configuration)
+ (lightdm-greeter-general-configuration)))
"The LightDM greeter configurations specifying the greeters to use.")
(seats
(list-of-seat-configurations (list (lightdm-seat-configuration
@@ -417,8 +504,11 @@ (define (validate-lightdm-configuration config)
(missing-greeters
(filter-map
(lambda (id)
- (define pred (greeter-session->greater-configuration-pred id))
- (if (find pred greeter-configurations)
+ (if (find (lambda (greeter-config)
+ (let* ((id (symbol->string id))
+ (name (greeter-configuration->session-name greeter-config)))
+ (equal? id name)))
+ greeter-configurations)
#f ;happy path
id))
greeter-sessions)))
@@ -428,10 +518,11 @@ (define pred (greeter-session->greater-configuration-pred id))
(define (lightdm-configuration-file config)
(match-record config <lightdm-configuration>
- (xorg-configuration seats
- xdmcp? xdmcp-listen-address
- vnc-server? vnc-server-command vnc-server-listen-address vnc-server-port
- extra-config)
+ (xorg-configuration
+ seats xdmcp? xdmcp-listen-address
+ vnc-server? vnc-server-command
+ vnc-server-listen-address vnc-server-port
+ extra-config)
(apply
mixed-text-file
"lightdm.conf" "
@@ -470,22 +561,22 @@ (define (lightdm-configuration-file config)
# Seat configuration.
#
"
- (map (lambda (seat)
- ;; This complication exists to propagate a default value for
- ;; the 'xserver-command' field of the seats. Having a
- ;; 'xorg-configuration' field at the root of the
- ;; lightdm-configuration enables the use of
- ;; 'set-xorg-configuration' and can be more convenient.
- (let ((seat* (if (maybe-value-set?
- (lightdm-seat-configuration-xserver-command seat))
- seat
- (lightdm-seat-configuration
- (inherit seat)
- (xserver-command (xorg-start-command
- xorg-configuration))))))
- (serialize-configuration seat*
- lightdm-seat-configuration-fields)))
- seats))))
+ (map (lambda (seat)
+ ;; This complication exists to propagate a default value for
+ ;; the 'xserver-command' field of the seats. Having a
+ ;; 'xorg-configuration' field at the root of the
+ ;; lightdm-configuration enables the use of
+ ;; 'set-xorg-configuration' and can be more convenient.
+ (let ((seat* (if (maybe-value-set?
+ (lightdm-seat-configuration-xserver-command seat))
+ seat
+ (lightdm-seat-configuration
+ (inherit seat)
+ (xserver-command (xorg-start-command
+ xorg-configuration))))))
+ (serialize-configuration seat*
+ lightdm-seat-configuration-fields)))
+ seats))))
(define (lightdm-configuration-directory config)
"Return a directory containing the serialized lightdm configuration
@@ -495,7 +586,8 @@ (define (lightdm-configuration-directory config)
(map (lambda (g)
`(,(greeter-configuration->conf-name g)
,(greeter-configuration->file g)))
- (lightdm-configuration-greeters config)))))
+ (filter greeter-configuration-valid?
+ (lightdm-configuration-greeters config))))))
(define %lightdm-accounts
(list (user-group (name "lightdm") (system? #t))
@@ -676,4 +768,5 @@ (define lightdm-service-type
(define (generate-doc)
(configuration->documentation 'lightdm-configuration)
(configuration->documentation 'lightdm-gtk-greeter-configuration)
+ (configuration->documentation 'lightdm-greeter-general-configuration)
(configuration->documentation 'lightdm-seat-configuration))
--
2.45.2
tumashu@HIDDEN, tumashu@HIDDEN, guix-patches@HIDDEN:bug#75048; Package guix-patches.
Full text available.
Received: (at 75048) by debbugs.gnu.org; 25 Dec 2024 03:08:30 +0000
From debbugs-submit-bounces <at> debbugs.gnu.org Tue Dec 24 22:08:30 2024
Received: from localhost ([127.0.0.1]:35648 helo=debbugs.gnu.org)
by debbugs.gnu.org with esmtp (Exim 4.84_2)
(envelope-from <debbugs-submit-bounces <at> debbugs.gnu.org>)
id 1tQHl7-0007nt-HR
for submit <at> debbugs.gnu.org; Tue, 24 Dec 2024 22:08:30 -0500
Received: from m16.mail.163.com ([220.197.31.5]:60960)
by debbugs.gnu.org with esmtp (Exim 4.84_2)
(envelope-from <tumashu@HIDDEN>) id 1tQHl3-0007nd-HC
for 75048 <at> debbugs.gnu.org; Tue, 24 Dec 2024 22:08:28 -0500
DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=163.com;
s=s110527; h=From:Subject:Date:Message-ID:MIME-Version; bh=K+Ojn
9PczqsHmQeGmRQnnwEUMmbYBif39VPOZNep8QI=; b=RdEkZV44L1v/YspP7b3NF
ZzFNUmZ7dCjXRrl29+QCayCystxvYnsBDhn1AOUqyDSuEeW31An3szgX0GZrawq0
TmMdYpv8x/6TTbG/OdAyPwj75BHT1DiQ4yxfUf11RMQNm1HlVOqqbRfaeERlG+rC
hXRoU0v1P804/md2Qo0SmQ=
Received: from localhost.localdomain (unknown [])
by gzga-smtp-mtada-g0-4 (Coremail) with SMTP id
_____wD3l0kjd2tnZKH_BQ--.15455S2;
Wed, 25 Dec 2024 11:08:20 +0800 (CST)
From: tumashu@HIDDEN
To: 75048 <at> debbugs.gnu.org
Subject: [PATCH v4] Add lightdm-greeter-general-configuration and do not hard
code config type name everywhere.
Date: Wed, 25 Dec 2024 11:08:05 +0800
Message-ID: <20241225030807.15055-1-tumashu@HIDDEN>
X-Mailer: git-send-email 2.45.2
MIME-Version: 1.0
X-Debbugs-Cc: Feng Shu <tumashu@HIDDEN>
Content-Transfer-Encoding: 8bit
X-CM-TRANSID: _____wD3l0kjd2tnZKH_BQ--.15455S2
X-Coremail-Antispam: 1Uf129KBjvAXoWfZF4rCFyDWF43GF4ruF1xKrg_yoW8tFW5Ko
Z3ZFW7Gr47Cr17WFnayr1fCr47Jryv9r48Zr18JryUAw1vqF43Ja4YvayUZF42kr4jkrn8
Gr95u39xAFWqyF4rn29KB7ZKAUJUUUU8529EdanIXcx71UUUUU7v73VFW2AGmfu7bjvjm3
AaLaJ3UbIYCTnIWIevJa73UjIFyTuYvjTRtmiEDUUUU
X-Originating-IP: [218.92.14.78]
X-CM-SenderInfo: 5wxpt2lkx6il2tof0z/1tbiEQHA1Gdrbd3+ogABsl
X-Spam-Score: 0.0 (/)
X-Debbugs-Envelope-To: 75048
Cc: Feng Shu <tumashu@HIDDEN>
X-BeenThere: debbugs-submit <at> debbugs.gnu.org
X-Mailman-Version: 2.1.18
Precedence: list
List-Id: <debbugs-submit.debbugs.gnu.org>
List-Unsubscribe: <https://debbugs.gnu.org/cgi-bin/mailman/options/debbugs-submit>,
<mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=unsubscribe>
List-Archive: <https://debbugs.gnu.org/cgi-bin/mailman/private/debbugs-submit/>
List-Post: <mailto:debbugs-submit <at> debbugs.gnu.org>
List-Help: <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=help>
List-Subscribe: <https://debbugs.gnu.org/cgi-bin/mailman/listinfo/debbugs-submit>,
<mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=subscribe>
Errors-To: debbugs-submit-bounces <at> debbugs.gnu.org
Sender: "Debbugs-submit" <debbugs-submit-bounces <at> debbugs.gnu.org>
X-Spam-Score: -1.0 (-)
From: Feng Shu <tumashu@HIDDEN>
* gnu/services/lightdm.scm (gnu): Use (ice-9 local-eval), export new option variables.
(local-eval-environment?): New variable.
(string): Move.
(lightdm-gtk-greeter-configuration): Add local-eval-environment,
greeter-session-name, greeter-package, greeter-config-name fields.
(lightdm-greeter-general-configuration): New variable.
(strip-record-type-name-brackets): Return string instead symbol.
(config->type-name): Rename from config->name.
(greeter-configuration-field): New function.
(greeter-configuration->greeter-fields): Do not hard code greeter configuation name.
(greeter-configuration->packages): Do not hard code greeter configuation name.
(greeter-configuration->conf-name): Improve.
(greeter-configuration->session-name): New variable.
(greeter-configuration->file): Call different function based config type.
(greeter-configuration->file/lightdm-gtk-greeter-configuration)
(greeter-configuration->file/lightdm-greeter-general-configuration): New functions.
(greeter-configuration-valid?): New function.
(greeter-session?): Do not hard code greeter configuation name.
(greeter-session->greater-configuration-pred)
(greeter-configuration->greeter-session): Removed.
(greeter-configuration?): Do not hard code greeter configuation name.
(lightdm-configuration): Add lightdm-greeter-general-configuration.
(validate-lightdm-configuration): Do not use greeter-session->greater-configuration-pred.
(generate-doc): Handle lightdm-greeter-general-configuration.
* doc/guix.texi (X Window): Improve lightdm-gtk-greeter-configuration options
doc, Add lightdm-greeter-general-configuration,
Change-Id: Iae22cd641454c86280e88d6986594ad0c8f4c490
---
doc/guix.texi | 94 +++++++++++++++-
gnu/services/lightdm.scm | 225 +++++++++++++++++++++++++++------------
2 files changed, 250 insertions(+), 69 deletions(-)
diff --git a/doc/guix.texi b/doc/guix.texi
index 31deb5b003..e1f1fee68b 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -23802,8 +23802,7 @@ In its most basic form, it can be used simply as:
(service lightdm-service-type)
@end lisp
-A more elaborate example making use of the VNC capabilities and enabling
-more features and verbose logs could look like:
+Two more elaborate examples look like below:
@lisp
(service lightdm-service-type
@@ -23819,6 +23818,38 @@ more features and verbose logs could look like:
(name "*")
(user-session "ratpoison"))))))
@end lisp
+
+@lisp
+(service lightdm-service-type
+ (lightdm-configuration
+ (greeters
+ (list (lightdm-greeter-general-configuration
+ (greeter-package lightdm-mini-greeter)
+ (greeter-session-name "lightdm-mini-greeter")
+ (greeter-config-name "lightdm-mini-greeter.conf")
+ (config (list "[greeter]"
+ "user = guest")))
+ (lightdm-gtk-greeter-configuration
+ (extra-config
+ (list "font-name = San 10"
+ "xft-dpi = 140"
+ "clock-format = %Y-%m-%d %H:%M"
+ ;; We need to use "~~" to generate a tilde, for
+ ;; extra-config sting will be handle as
+ ;; control-string of format function.
+ "indicators = ~~host;~~spacer;~~session;~~a11y;~~clock;~~power")))))
+ (seats
+ (list (lightdm-seat-configuration
+ (name "*")
+ (greeter-session 'lightdm-mini-greeter))))
+ (xorg-configuration
+ (xorg-configuration
+ (server-arguments
+ (append %default-xorg-server-arguments
+ '("-dpi" "140")))))))
+@end lisp
+
+
@end defvar
@c The LightDM service documentation can be auto-generated via the
@@ -23903,8 +23934,21 @@ Extra configuration values to append to the LightDM configuration file.
Available @code{lightdm-gtk-greeter-configuration} fields are:
@table @asis
+@item @code{local-eval-environment} (default: @code{(the-environment)}) (type: local-eval-environment)
+Recode the environment where lightdm-gtk-greeter-configuration is defined.
+
@item @code{lightdm-gtk-greeter} (default: @code{lightdm-gtk-greeter}) (type: file-like)
-The lightdm-gtk-greeter package to use.
+The lightdm-gtk-greeter package to use, this option is keeped for
+compatibility, use greeter-package instead.
+
+@item @code{greeter-package} (default: @code{lightdm-gtk-greeter}) (type: file-like)
+The greeter package to use.
+
+@item @code{greeter-session-name} (default: @code{lightdm-gtk-greeter}) (type: string)
+The session name used in lightdm.conf.
+
+@item @code{greeter-config-name} (default: @code{lightdm-gtk-greeter.conf}) (type: string)
+The greeter config file name in /etc/lightdm directory.
@item @code{assets} (default: @code{(adwaita-icon-theme gnome-themes-extra hicolor-icon-theme)}) (type: list-of-file-likes)
The list of packages complementing the greeter, such as package
@@ -23948,6 +23992,50 @@ configuration file.
@c %end of fragment
@c %start of fragment
+@deftp {Data Type} lightdm-greeter-general-configuration
+
+@code{lightdm-greeter-general-configuration} support all text config
+greeters which have no build-in configuration type like
+@code{lightdm-gtk-greeter-configuration}, such as lightdm-mini-greeter,
+for example:
+
+@lisp
+(lightdm-greeter-general-configuration
+ (greeter-package lightdm-mini-greeter)
+ (greeter-session-name "lightdm-mini-greeter")
+ (greeter-config-name "lightdm-mini-greeter.conf")
+ (config (list "[greeter]"
+ "user = guest")))
+@end lisp
+
+Available @code{lightdm-greeter-general-configuration} fields are:
+
+@table @asis
+@item @code{local-eval-environment} (default: @code{(the-environment)}) (type: local-eval-environment)
+Recode the environment where lightdm-greeter-general-configuration is defined.
+
+@item @code{greeter-package} (type: maybe-file-like)
+The greeter package to use.
+
+@item @code{greeter-session-name} (type: maybe-string)
+The session name used in lightdm.conf.
+
+@item @code{greeter-config-name} (type: maybe-string)
+The greeter config file name in /etc/lightdm directory.
+
+@item @code{assets} (default: @code{(adwaita-icon-theme gnome-themes-extra hicolor-icon-theme)}) (type: list-of-file-likes)
+The list of packages complementing the greeter, such as package
+providing icon themes.
+
+@item @code{config} (default: @code{'()}) (type: list-of-strings)
+Configuration values of the LightDM Greeter configuration file.
+
+@end table
+@end deftp
+
+@c %end of fragment
+@c %start of fragment
+
@deftp {Data Type} lightdm-seat-configuration
Available @code{lightdm-seat-configuration} fields are:
diff --git a/gnu/services/lightdm.scm b/gnu/services/lightdm.scm
index 191cb5635b..e03549e974 100644
--- a/gnu/services/lightdm.scm
+++ b/gnu/services/lightdm.scm
@@ -39,6 +39,7 @@ (define-module (gnu services lightdm)
#:use-module (guix i18n)
#:use-module (guix records)
#:use-module (ice-9 format)
+ #:use-module (ice-9 local-eval)
#:use-module (ice-9 match)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-26)
@@ -56,7 +57,10 @@ (define-module (gnu services lightdm)
lightdm-gtk-greeter-configuration
lightdm-gtk-greeter-configuration?
lightdm-gtk-greeter-configuration-lightdm-gtk-greeter
+ lightdm-gtk-greeter-configuration-greeter-package
lightdm-gtk-greeter-configuration-assets
+ lightdm-gtk-greeter-configuration-greeter-config-name
+ lightdm-gtk-greeter-configuration-greeter-session-name
lightdm-gtk-greeter-configuration-theme-name
lightdm-gtk-greeter-configuration-icon-theme-name
lightdm-gtk-greeter-configuration-cursor-theme-name
@@ -66,6 +70,14 @@ (define-module (gnu services lightdm)
lightdm-gtk-greeter-configuration-reader
lightdm-gtk-greeter-configuration-extra-config
+ lightdm-greeter-general-configuration
+ lightdm-greeter-general-configuration?
+ lightdm-greeter-general-configuration-greeter-package
+ lightdm-greeter-general-configuration-assets
+ lightdm-greeter-general-configuration-greeter-config-name
+ lightdm-greeter-general-configuration-greeter-session-name
+ lightdm-greeter-general-configuration-config
+
lightdm-configuration
lightdm-configuration?
lightdm-configuration-lightdm
@@ -87,6 +99,9 @@ (define-module (gnu services lightdm)
;;; Greeters.
;;;
+(define (local-eval-environment? value)
+ #t)
+
(define list-of-file-likes?
(list-of file-like?))
@@ -117,6 +132,8 @@ (define (serialize-file-like name value)
(define (serialize-list-of-a11y-states name value)
(format #f "~a=~a~%" name (string-join (map symbol->string value) ";")))
+(define-maybe string)
+
(define (serialize-string name value)
(format #f "~a=~a~%" name value))
@@ -127,9 +144,21 @@ (define (serialize-list-of-strings _ value)
(string-join value "\n"))
(define-configuration lightdm-gtk-greeter-configuration
+ (local-eval-environment
+ (local-eval-environment (the-environment))
+ "Recode the environment where lightdm-gtk-greeter-configuration is defined."
+ empty-serializer)
+ (greeter-session-name
+ (string "lightdm-gtk-greeter")
+ "Session name used in lightdm.conf"
+ empty-serializer)
(lightdm-gtk-greeter
+ maybe-file-like
+ "Keep it for compatibility, use greeter-package field instead."
+ empty-serializer)
+ (greeter-package
(file-like lightdm-gtk-greeter)
- "The lightdm-gtk-greeter package to use."
+ "The greeter package to use."
empty-serializer)
(assets
(list-of-file-likes (list adwaita-icon-theme
@@ -140,6 +169,10 @@ (define-configuration lightdm-gtk-greeter-configuration
"The list of packages complementing the greeter, such as package providing
icon themes."
empty-serializer)
+ (greeter-config-name
+ (string "lightdm-gtk-greeter.conf")
+ "Greeter config file name in /etc/lightdm directory."
+ empty-serializer)
(theme-name
(string "Adwaita")
"The name of the theme to use.")
@@ -176,34 +209,81 @@ (define-configuration lightdm-gtk-greeter-configuration
"Extra configuration values to append to the LightDM GTK Greeter
configuration file."))
+(define-configuration lightdm-greeter-general-configuration
+ (local-eval-environment
+ (local-eval-environment (the-environment))
+ "Recode the environment where lightdm-greeter-general-configuration is defined."
+ empty-serializer)
+ (greeter-package
+ maybe-file-like
+ "The greeter package to use."
+ empty-serializer)
+ (assets
+ (list-of-file-likes (list adwaita-icon-theme
+ gnome-themes-extra
+ ;; FIXME: hicolor-icon-theme should be in the
+ ;; packages of the desktop templates.
+ hicolor-icon-theme))
+ "The list of packages complementing the greeter, such as package providing
+icon themes."
+ empty-serializer)
+ (greeter-config-name
+ maybe-string
+ "Greeter config file name in /etc/lightdm directory."
+ empty-serializer)
+ (greeter-session-name
+ maybe-string
+ "Session name used in lightdm.conf"
+ empty-serializer)
+ (config
+ (list-of-strings '())
+ "Configuration values of the LightDM Greeter configuration file."))
+
(define (strip-record-type-name-brackets name)
"Remove the '<' and '>' brackets from NAME, a symbol."
(let ((name (symbol->string name)))
(if (and (string-prefix? "<" name)
(string-suffix? ">" name))
- (string->symbol (string-drop (string-drop-right name 1) 1))
+ (string-drop (string-drop-right name 1) 1)
(error "unexpected record type name" name))))
-(define (config->name config)
- "Return the constructor name (a symbol) from CONFIG."
+(define (config->type-name config)
+ "Return the type name of CONFIG."
(strip-record-type-name-brackets
(record-type-name (struct-vtable config))))
+(define (greeter-configuration-field config field)
+ "Return field value of config."
+ (let ((rtd (struct-vtable config)))
+ ((record-accessor rtd field) config)))
+
+(define (greeter-configuration->session-name config)
+ "Return the session name of CONFIG, a greeter configuration."
+ (greeter-configuration-field config 'greeter-session-name))
+
(define (greeter-configuration->greeter-fields config)
"Return the fields of CONFIG, a greeter configuration."
- (match config
- ;; Note: register any new greeter configuration here.
- ((? lightdm-gtk-greeter-configuration?)
- lightdm-gtk-greeter-configuration-fields)))
+ (let* ((type-name (config->type-name config))
+ (variable (string->symbol (string-append type-name "-fields")))
+ (eval-env (greeter-configuration-field config 'local-eval-environment)))
+ (local-eval variable eval-env)))
(define (greeter-configuration->packages config)
"Return the list of greeter packages, including assets, used by CONFIG, a
greeter configuration."
- (match config
- ;; Note: register any new greeter configuration here.
- ((? lightdm-gtk-greeter-configuration?)
- (cons (lightdm-gtk-greeter-configuration-lightdm-gtk-greeter config)
- (lightdm-gtk-greeter-configuration-assets config)))))
+ (filter file-like?
+ (cons (greeter-configuration->greeter-package config)
+ (greeter-configuration-field config 'assets))))
+
+(define (greeter-configuration->greeter-package config)
+ "Return greeter package used by CONFIG, a greeter configuration."
+ (let ((type-name (config->type-name config))
+ (pkg1 (greeter-configuration-field config 'greeter-package)))
+ (if (eq? type-name "lightdm-gtk-greeter-configuration")
+ ;; Handle lightdm-gtk-greeter field for keeping it for compatibility.
+ (let ((pkg2 (greeter-configuration-field config 'lightdm-gtk-greeter)))
+ (if (file-like? pkg2) pkg2 pkg1))
+ pkg1)))
;;; TODO: Implement directly in (gnu services configuration), perhaps by
;;; making the FIELDS argument optional.
@@ -215,11 +295,19 @@ (define fields (greeter-configuration->greeter-fields config))
(define (greeter-configuration->conf-name config)
"Return the file name of CONFIG, a greeter configuration."
- (format #f "~a.conf" (greeter-configuration->greeter-session config)))
+ (greeter-configuration-field config 'greeter-config-name))
(define (greeter-configuration->file config)
"Serialize CONFIG into a file under the output directory, so that it can be
easily added to XDG_CONF_DIRS."
+ (let* ((type-name (config->type-name config))
+ (func-name (string->symbol
+ (string-append
+ "greeter-configuration->file/" type-name)))
+ (eval-env (greeter-configuration-field config 'local-eval-environment)))
+ (local-eval `(,func-name ,config) eval-env)))
+
+(define (greeter-configuration->file/lightdm-gtk-greeter-configuration config)
(computed-file
(greeter-configuration->conf-name config)
#~(begin
@@ -229,6 +317,23 @@ (define (greeter-configuration->file config)
"[greeter]\n"
#$(serialize-configuration* config))))))))
+(define (greeter-configuration->file/lightdm-greeter-general-configuration config)
+ (computed-file
+ (greeter-configuration->conf-name config)
+ #~(begin
+ (call-with-output-file #$output
+ (lambda (port)
+ (format port #$(serialize-configuration* config)))))))
+
+(define (greeter-configuration-valid? config)
+ "Check greeter-configuration CONFIG valid or not."
+ (let ((conf-name (greeter-configuration->conf-name config))
+ (session-name (greeter-configuration->session-name config)))
+ (and (string? conf-name)
+ (string? session-name)
+ (> (string-length conf-name) 0)
+ (> (string-length session-name) 0))))
+
;;;
;;; Seats.
@@ -248,15 +353,14 @@ (define (serialize-seat-type name value)
(define-maybe seat-type)
(define (greeter-session? value)
- (memq value '(lightdm-gtk-greeter)))
+ (and (symbol? value)
+ (string-contains (symbol->string value) "-greeter" )))
(define (serialize-greeter-session name value)
(format #f "~a=~a~%" name value))
(define-maybe greeter-session)
-(define-maybe string)
-
;;; Note: all the fields except for the seat name should be 'maybe's, since
;;; the real default value is set by the %lightdm-seat-default define later,
;;; and this avoids repeating ourselves in the serialized configuration file.
@@ -291,22 +395,6 @@ (define-configuration lightdm-seat-configuration
(list-of-strings '())
"Extra configuration values to append to the seat configuration section."))
-(define (greeter-session->greater-configuration-pred identifier)
- "Return the predicate to check if a configuration is of the type specifying
-a greeter identified by IDENTIFIER."
- (match identifier
- ;; Note: register any new greeter identifier here.
- ('lightdm-gtk-greeter
- lightdm-gtk-greeter-configuration?)))
-
-(define (greeter-configuration->greeter-session config)
- "Given CONFIG, a greeter configuration object, return its identifier,
-a symbol."
- (let ((suffix "-configuration")
- (greeter-conf-name (config->name config)))
- (string->symbol (string-drop-right (symbol->string greeter-conf-name)
- (string-length suffix)))))
-
(define list-of-seat-configurations?
(list-of lightdm-seat-configuration?))
@@ -316,20 +404,17 @@ (define list-of-seat-configurations?
;;;
(define (greeter-configuration? config)
- (or (lightdm-gtk-greeter-configuration? config)
- ;; Note: register any new greeter configuration here.
- ))
+ ((record-predicate (struct-vtable config)) config))
(define (list-of-greeter-configurations? greeter-configs)
(and ((list-of greeter-configuration?) greeter-configs)
;; Greeter configurations must also not be provided more than once.
- (let* ((types (map (compose record-type-name struct-vtable)
- greeter-configs))
- (dupes (filter (lambda (type)
- (< 1 (count (cut eq? type <>) types)))
- types)))
+ (let* ((conf-names (map greeter-configuration->conf-name greeter-configs))
+ (dupes (filter (lambda (conf-name)
+ (< 1 (count (cut eq? conf-name <>) conf-names)))
+ conf-names)))
(unless (null? dupes)
- (leave (G_ "duplicate greeter configurations: ~a~%") dupes)))))
+ (leave (G_ "Duplicate greeter configurations: ~a~%") dupes)))))
(define-configuration/no-serialization lightdm-configuration
(lightdm
@@ -347,7 +432,9 @@ (define-configuration/no-serialization lightdm-configuration
start script. It can be refined per seat via the @code{xserver-command} of
the @code{<lightdm-seat-configuration>} record, if desired.")
(greeters
- (list-of-greeter-configurations (list (lightdm-gtk-greeter-configuration)))
+ (list-of-greeter-configurations
+ (list (lightdm-gtk-greeter-configuration)
+ (lightdm-greeter-general-configuration)))
"The LightDM greeter configurations specifying the greeters to use.")
(seats
(list-of-seat-configurations (list (lightdm-seat-configuration
@@ -417,8 +504,11 @@ (define (validate-lightdm-configuration config)
(missing-greeters
(filter-map
(lambda (id)
- (define pred (greeter-session->greater-configuration-pred id))
- (if (find pred greeter-configurations)
+ (if (find (lambda (greeter-config)
+ (let* ((id (symbol->string id))
+ (name (greeter-configuration->session-name greeter-config)))
+ (equal? id name)))
+ greeter-configurations)
#f ;happy path
id))
greeter-sessions)))
@@ -428,10 +518,11 @@ (define pred (greeter-session->greater-configuration-pred id))
(define (lightdm-configuration-file config)
(match-record config <lightdm-configuration>
- (xorg-configuration seats
- xdmcp? xdmcp-listen-address
- vnc-server? vnc-server-command vnc-server-listen-address vnc-server-port
- extra-config)
+ (xorg-configuration
+ seats xdmcp? xdmcp-listen-address
+ vnc-server? vnc-server-command
+ vnc-server-listen-address vnc-server-port
+ extra-config)
(apply
mixed-text-file
"lightdm.conf" "
@@ -470,22 +561,22 @@ (define (lightdm-configuration-file config)
# Seat configuration.
#
"
- (map (lambda (seat)
- ;; This complication exists to propagate a default value for
- ;; the 'xserver-command' field of the seats. Having a
- ;; 'xorg-configuration' field at the root of the
- ;; lightdm-configuration enables the use of
- ;; 'set-xorg-configuration' and can be more convenient.
- (let ((seat* (if (maybe-value-set?
- (lightdm-seat-configuration-xserver-command seat))
- seat
- (lightdm-seat-configuration
- (inherit seat)
- (xserver-command (xorg-start-command
- xorg-configuration))))))
- (serialize-configuration seat*
- lightdm-seat-configuration-fields)))
- seats))))
+ (map (lambda (seat)
+ ;; This complication exists to propagate a default value for
+ ;; the 'xserver-command' field of the seats. Having a
+ ;; 'xorg-configuration' field at the root of the
+ ;; lightdm-configuration enables the use of
+ ;; 'set-xorg-configuration' and can be more convenient.
+ (let ((seat* (if (maybe-value-set?
+ (lightdm-seat-configuration-xserver-command seat))
+ seat
+ (lightdm-seat-configuration
+ (inherit seat)
+ (xserver-command (xorg-start-command
+ xorg-configuration))))))
+ (serialize-configuration seat*
+ lightdm-seat-configuration-fields)))
+ seats))))
(define (lightdm-configuration-directory config)
"Return a directory containing the serialized lightdm configuration
@@ -495,7 +586,8 @@ (define (lightdm-configuration-directory config)
(map (lambda (g)
`(,(greeter-configuration->conf-name g)
,(greeter-configuration->file g)))
- (lightdm-configuration-greeters config)))))
+ (filter greeter-configuration-valid?
+ (lightdm-configuration-greeters config))))))
(define %lightdm-accounts
(list (user-group (name "lightdm") (system? #t))
@@ -676,4 +768,5 @@ (define lightdm-service-type
(define (generate-doc)
(configuration->documentation 'lightdm-configuration)
(configuration->documentation 'lightdm-gtk-greeter-configuration)
+ (configuration->documentation 'lightdm-greeter-general-configuration)
(configuration->documentation 'lightdm-seat-configuration))
--
2.45.2
tumashu@HIDDEN, guix-patches@HIDDEN:bug#75048; Package guix-patches.
Full text available.
Received: (at 75048) by debbugs.gnu.org; 24 Dec 2024 07:33:35 +0000
From debbugs-submit-bounces <at> debbugs.gnu.org Tue Dec 24 02:33:35 2024
Received: from localhost ([127.0.0.1]:59184 helo=debbugs.gnu.org)
by debbugs.gnu.org with esmtp (Exim 4.84_2)
(envelope-from <debbugs-submit-bounces <at> debbugs.gnu.org>)
id 1tPzQ5-0007fe-S5
for submit <at> debbugs.gnu.org; Tue, 24 Dec 2024 02:33:35 -0500
Received: from m16.mail.163.com ([117.135.210.4]:56170)
by debbugs.gnu.org with esmtp (Exim 4.84_2)
(envelope-from <tumashu@HIDDEN>) id 1tPzQ0-0007fL-4s
for 75048 <at> debbugs.gnu.org; Tue, 24 Dec 2024 02:33:31 -0500
DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=163.com;
s=s110527; h=From:Subject:Date:Message-ID:MIME-Version:
Content-Type; bh=IZwj5X+IAbPq8yhOKy18JTuUoHd2x4neIbouoxclz5Q=;
b=C28NpQ96i9a8NvPc6phHSmguRFhZO8V6jp1FQl375uWzRT9PiCl0lm+0/gWZnm
EF5obyH3Z6V4cOzBkenHNJEcAyNpr1Dtf8y6xuZ93gu9u/72+i0VVLzbNP5KvrVB
jvfHmvfpqQbcoo0l2CYzwUD+GmCPp17/KiB8xNSu94+bU=
Received: from Tumashu (unknown [])
by gzga-smtp-mtada-g1-3 (Coremail) with SMTP id
_____wBXqj3AY2pnggpXBQ--.28608S2;
Tue, 24 Dec 2024 15:33:21 +0800 (CST)
From: Feng Shu <tumashu@HIDDEN>
To: 75048 <at> debbugs.gnu.org
Subject: [PATCH v3] Add lightdm-greeter-general-configuration and do not
hard code config type name everywhere.
Date: Tue, 24 Dec 2024 15:33:20 +0800
Message-ID: <87cyhho7r3.fsf@HIDDEN>
User-Agent: Gnus/5.13 (Gnus v5.13)
MIME-Version: 1.0
Content-Type: text/plain
X-CM-TRANSID: _____wBXqj3AY2pnggpXBQ--.28608S2
X-Coremail-Antispam: 1Uf129KBjvAXoWfXFy3Zr4DAr15Zry5Gw4UJwb_yoW8tw45Ao
Z3ZFW7Gr47Cr17WFnayr1fCr47Jryv9r48Zr18JryUAw1vqF43Ja4YvayUZF42kr4jkrn8
Gr95u39xAayqyF4rn29KB7ZKAUJUUUU8529EdanIXcx71UUUUU7v73VFW2AGmfu7bjvjm3
AaLaJ3UbIYCTnIWIevJa73UjIFyTuYvjxU5CztUUUUU
X-Originating-IP: [218.92.14.78]
X-CM-SenderInfo: 5wxpt2lkx6il2tof0z/1tbiYB6-1GdqXGvHzAAAsk
X-Spam-Score: 0.0 (/)
X-Debbugs-Envelope-To: 75048
X-BeenThere: debbugs-submit <at> debbugs.gnu.org
X-Mailman-Version: 2.1.18
Precedence: list
List-Id: <debbugs-submit.debbugs.gnu.org>
List-Unsubscribe: <https://debbugs.gnu.org/cgi-bin/mailman/options/debbugs-submit>,
<mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=unsubscribe>
List-Archive: <https://debbugs.gnu.org/cgi-bin/mailman/private/debbugs-submit/>
List-Post: <mailto:debbugs-submit <at> debbugs.gnu.org>
List-Help: <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=help>
List-Subscribe: <https://debbugs.gnu.org/cgi-bin/mailman/listinfo/debbugs-submit>,
<mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=subscribe>
Errors-To: debbugs-submit-bounces <at> debbugs.gnu.org
Sender: "Debbugs-submit" <debbugs-submit-bounces <at> debbugs.gnu.org>
X-Spam-Score: -1.0 (-)
From 7fd615c0b03356414919a6ae2799758491b8f582 Mon Sep 17 00:00:00 2001
From: Feng Shu <tumashu@HIDDEN>
Date: Mon, 23 Dec 2024 19:30:28 +0800
Subject: [PATCH v3] Add lightdm-greeter-general-configuration and do not hard
code config type name everywhere.
* gnu/services/lightdm.scm (gnu): Use (ice-9 local-eval), export new option variables.
(local-eval-environment?): New variable.
(string): Move.
(lightdm-gtk-greeter-configuration): Add local-eval-environment,
greeter-session-name, greeter-package, greeter-config-name fields.
(lightdm-greeter-general-configuration): New variable.
(strip-record-type-name-brackets): Return string instead symbol.
(config->type-name): Rename from config->name.
(greeter-configuration-field): New function.
(greeter-configuration->greeter-fields): Do not hard code greeter configuation name.
(greeter-configuration->packages): Do not hard code greeter configuation name.
(greeter-configuration->conf-name): Improve.
(greeter-configuration->session-name): New variable.
(greeter-configuration->file): Call different function based config type.
(greeter-configuration->file/lightdm-gtk-greeter-configuration)
(greeter-configuration->file/lightdm-greeter-general-configuration): New functions.
(greeter-configuration-valid?): New function.
(greeter-session?): Do not hard code greeter configuation name.
(greeter-session->greater-configuration-pred)
(greeter-configuration->greeter-session): Removed.
(greeter-configuration?): Do not hard code greeter configuation name.
(lightdm-configuration): Add lightdm-greeter-general-configuration.
(validate-lightdm-configuration): Do not use greeter-session->greater-configuration-pred.
(generate-doc): Handle lightdm-greeter-general-configuration.
* doc/guix.texi (X Window): Improve lightdm-gtk-greeter-configuration options
doc, Add lightdm-greeter-general-configuration,
Change-Id: Iae22cd641454c86280e88d6986594ad0c8f4c490
---
doc/guix.texi | 94 +++++++++++++++-
gnu/services/lightdm.scm | 225 +++++++++++++++++++++++++++------------
2 files changed, 250 insertions(+), 69 deletions(-)
diff --git a/doc/guix.texi b/doc/guix.texi
index 31deb5b003..e1f1fee68b 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -23802,8 +23802,7 @@ In its most basic form, it can be used simply as:
(service lightdm-service-type)
@end lisp
-A more elaborate example making use of the VNC capabilities and enabling
-more features and verbose logs could look like:
+Two more elaborate examples look like below:
@lisp
(service lightdm-service-type
@@ -23819,6 +23818,38 @@ more features and verbose logs could look like:
(name "*")
(user-session "ratpoison"))))))
@end lisp
+
+@lisp
+(service lightdm-service-type
+ (lightdm-configuration
+ (greeters
+ (list (lightdm-greeter-general-configuration
+ (greeter-package lightdm-mini-greeter)
+ (greeter-session-name "lightdm-mini-greeter")
+ (greeter-config-name "lightdm-mini-greeter.conf")
+ (config (list "[greeter]"
+ "user = guest")))
+ (lightdm-gtk-greeter-configuration
+ (extra-config
+ (list "font-name = San 10"
+ "xft-dpi = 140"
+ "clock-format = %Y-%m-%d %H:%M"
+ ;; We need to use "~~" to generate a tilde, for
+ ;; extra-config sting will be handle as
+ ;; control-string of format function.
+ "indicators = ~~host;~~spacer;~~session;~~a11y;~~clock;~~power")))))
+ (seats
+ (list (lightdm-seat-configuration
+ (name "*")
+ (greeter-session 'lightdm-mini-greeter))))
+ (xorg-configuration
+ (xorg-configuration
+ (server-arguments
+ (append %default-xorg-server-arguments
+ '("-dpi" "140")))))))
+@end lisp
+
+
@end defvar
@c The LightDM service documentation can be auto-generated via the
@@ -23903,8 +23934,21 @@ Extra configuration values to append to the LightDM configuration file.
Available @code{lightdm-gtk-greeter-configuration} fields are:
@table @asis
+@item @code{local-eval-environment} (default: @code{(the-environment)}) (type: local-eval-environment)
+Recode the environment where lightdm-gtk-greeter-configuration is defined.
+
@item @code{lightdm-gtk-greeter} (default: @code{lightdm-gtk-greeter}) (type: file-like)
-The lightdm-gtk-greeter package to use.
+The lightdm-gtk-greeter package to use, this option is keeped for
+compatibility, use greeter-package instead.
+
+@item @code{greeter-package} (default: @code{lightdm-gtk-greeter}) (type: file-like)
+The greeter package to use.
+
+@item @code{greeter-session-name} (default: @code{lightdm-gtk-greeter}) (type: string)
+The session name used in lightdm.conf.
+
+@item @code{greeter-config-name} (default: @code{lightdm-gtk-greeter.conf}) (type: string)
+The greeter config file name in /etc/lightdm directory.
@item @code{assets} (default: @code{(adwaita-icon-theme gnome-themes-extra hicolor-icon-theme)}) (type: list-of-file-likes)
The list of packages complementing the greeter, such as package
@@ -23948,6 +23992,50 @@ configuration file.
@c %end of fragment
@c %start of fragment
+@deftp {Data Type} lightdm-greeter-general-configuration
+
+@code{lightdm-greeter-general-configuration} support all text config
+greeters which have no build-in configuration type like
+@code{lightdm-gtk-greeter-configuration}, such as lightdm-mini-greeter,
+for example:
+
+@lisp
+(lightdm-greeter-general-configuration
+ (greeter-package lightdm-mini-greeter)
+ (greeter-session-name "lightdm-mini-greeter")
+ (greeter-config-name "lightdm-mini-greeter.conf")
+ (config (list "[greeter]"
+ "user = guest")))
+@end lisp
+
+Available @code{lightdm-greeter-general-configuration} fields are:
+
+@table @asis
+@item @code{local-eval-environment} (default: @code{(the-environment)}) (type: local-eval-environment)
+Recode the environment where lightdm-greeter-general-configuration is defined.
+
+@item @code{greeter-package} (type: maybe-file-like)
+The greeter package to use.
+
+@item @code{greeter-session-name} (type: maybe-string)
+The session name used in lightdm.conf.
+
+@item @code{greeter-config-name} (type: maybe-string)
+The greeter config file name in /etc/lightdm directory.
+
+@item @code{assets} (default: @code{(adwaita-icon-theme gnome-themes-extra hicolor-icon-theme)}) (type: list-of-file-likes)
+The list of packages complementing the greeter, such as package
+providing icon themes.
+
+@item @code{config} (default: @code{'()}) (type: list-of-strings)
+Configuration values of the LightDM Greeter configuration file.
+
+@end table
+@end deftp
+
+@c %end of fragment
+@c %start of fragment
+
@deftp {Data Type} lightdm-seat-configuration
Available @code{lightdm-seat-configuration} fields are:
diff --git a/gnu/services/lightdm.scm b/gnu/services/lightdm.scm
index 191cb5635b..e03549e974 100644
--- a/gnu/services/lightdm.scm
+++ b/gnu/services/lightdm.scm
@@ -39,6 +39,7 @@ (define-module (gnu services lightdm)
#:use-module (guix i18n)
#:use-module (guix records)
#:use-module (ice-9 format)
+ #:use-module (ice-9 local-eval)
#:use-module (ice-9 match)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-26)
@@ -56,7 +57,10 @@ (define-module (gnu services lightdm)
lightdm-gtk-greeter-configuration
lightdm-gtk-greeter-configuration?
lightdm-gtk-greeter-configuration-lightdm-gtk-greeter
+ lightdm-gtk-greeter-configuration-greeter-package
lightdm-gtk-greeter-configuration-assets
+ lightdm-gtk-greeter-configuration-greeter-config-name
+ lightdm-gtk-greeter-configuration-greeter-session-name
lightdm-gtk-greeter-configuration-theme-name
lightdm-gtk-greeter-configuration-icon-theme-name
lightdm-gtk-greeter-configuration-cursor-theme-name
@@ -66,6 +70,14 @@ (define-module (gnu services lightdm)
lightdm-gtk-greeter-configuration-reader
lightdm-gtk-greeter-configuration-extra-config
+ lightdm-greeter-general-configuration
+ lightdm-greeter-general-configuration?
+ lightdm-greeter-general-configuration-greeter-package
+ lightdm-greeter-general-configuration-assets
+ lightdm-greeter-general-configuration-greeter-config-name
+ lightdm-greeter-general-configuration-greeter-session-name
+ lightdm-greeter-general-configuration-config
+
lightdm-configuration
lightdm-configuration?
lightdm-configuration-lightdm
@@ -87,6 +99,9 @@ (define-module (gnu services lightdm)
;;; Greeters.
;;;
+(define (local-eval-environment? value)
+ #t)
+
(define list-of-file-likes?
(list-of file-like?))
@@ -117,6 +132,8 @@ (define (serialize-file-like name value)
(define (serialize-list-of-a11y-states name value)
(format #f "~a=~a~%" name (string-join (map symbol->string value) ";")))
+(define-maybe string)
+
(define (serialize-string name value)
(format #f "~a=~a~%" name value))
@@ -127,9 +144,21 @@ (define (serialize-list-of-strings _ value)
(string-join value "\n"))
(define-configuration lightdm-gtk-greeter-configuration
+ (local-eval-environment
+ (local-eval-environment (the-environment))
+ "Recode the environment where lightdm-gtk-greeter-configuration is defined."
+ empty-serializer)
+ (greeter-session-name
+ (string "lightdm-gtk-greeter")
+ "Session name used in lightdm.conf"
+ empty-serializer)
(lightdm-gtk-greeter
+ maybe-file-like
+ "Keep it for compatibility, use greeter-package field instead."
+ empty-serializer)
+ (greeter-package
(file-like lightdm-gtk-greeter)
- "The lightdm-gtk-greeter package to use."
+ "The greeter package to use."
empty-serializer)
(assets
(list-of-file-likes (list adwaita-icon-theme
@@ -140,6 +169,10 @@ (define-configuration lightdm-gtk-greeter-configuration
"The list of packages complementing the greeter, such as package providing
icon themes."
empty-serializer)
+ (greeter-config-name
+ (string "lightdm-gtk-greeter.conf")
+ "Greeter config file name in /etc/lightdm directory."
+ empty-serializer)
(theme-name
(string "Adwaita")
"The name of the theme to use.")
@@ -176,34 +209,81 @@ (define-configuration lightdm-gtk-greeter-configuration
"Extra configuration values to append to the LightDM GTK Greeter
configuration file."))
+(define-configuration lightdm-greeter-general-configuration
+ (local-eval-environment
+ (local-eval-environment (the-environment))
+ "Recode the environment where lightdm-greeter-general-configuration is defined."
+ empty-serializer)
+ (greeter-package
+ maybe-file-like
+ "The greeter package to use."
+ empty-serializer)
+ (assets
+ (list-of-file-likes (list adwaita-icon-theme
+ gnome-themes-extra
+ ;; FIXME: hicolor-icon-theme should be in the
+ ;; packages of the desktop templates.
+ hicolor-icon-theme))
+ "The list of packages complementing the greeter, such as package providing
+icon themes."
+ empty-serializer)
+ (greeter-config-name
+ maybe-string
+ "Greeter config file name in /etc/lightdm directory."
+ empty-serializer)
+ (greeter-session-name
+ maybe-string
+ "Session name used in lightdm.conf"
+ empty-serializer)
+ (config
+ (list-of-strings '())
+ "Configuration values of the LightDM Greeter configuration file."))
+
(define (strip-record-type-name-brackets name)
"Remove the '<' and '>' brackets from NAME, a symbol."
(let ((name (symbol->string name)))
(if (and (string-prefix? "<" name)
(string-suffix? ">" name))
- (string->symbol (string-drop (string-drop-right name 1) 1))
+ (string-drop (string-drop-right name 1) 1)
(error "unexpected record type name" name))))
-(define (config->name config)
- "Return the constructor name (a symbol) from CONFIG."
+(define (config->type-name config)
+ "Return the type name of CONFIG."
(strip-record-type-name-brackets
(record-type-name (struct-vtable config))))
+(define (greeter-configuration-field config field)
+ "Return field value of config."
+ (let ((rtd (struct-vtable config)))
+ ((record-accessor rtd field) config)))
+
+(define (greeter-configuration->session-name config)
+ "Return the session name of CONFIG, a greeter configuration."
+ (greeter-configuration-field config 'greeter-session-name))
+
(define (greeter-configuration->greeter-fields config)
"Return the fields of CONFIG, a greeter configuration."
- (match config
- ;; Note: register any new greeter configuration here.
- ((? lightdm-gtk-greeter-configuration?)
- lightdm-gtk-greeter-configuration-fields)))
+ (let* ((type-name (config->type-name config))
+ (variable (string->symbol (string-append type-name "-fields")))
+ (eval-env (greeter-configuration-field config 'local-eval-environment)))
+ (local-eval variable eval-env)))
(define (greeter-configuration->packages config)
"Return the list of greeter packages, including assets, used by CONFIG, a
greeter configuration."
- (match config
- ;; Note: register any new greeter configuration here.
- ((? lightdm-gtk-greeter-configuration?)
- (cons (lightdm-gtk-greeter-configuration-lightdm-gtk-greeter config)
- (lightdm-gtk-greeter-configuration-assets config)))))
+ (filter file-like?
+ (cons (greeter-configuration->greeter-package config)
+ (greeter-configuration-field config 'assets))))
+
+(define (greeter-configuration->greeter-package config)
+ "Return greeter package used by CONFIG, a greeter configuration."
+ (let ((type-name (config->type-name config))
+ (pkg1 (greeter-configuration-field config 'greeter-package)))
+ (if (eq? type-name "lightdm-gtk-greeter-configuration")
+ ;; Handle lightdm-gtk-greeter field for keeping it for compatibility.
+ (let ((pkg2 (greeter-configuration-field config 'lightdm-gtk-greeter)))
+ (if (file-like? pkg2) pkg2 pkg1))
+ pkg1)))
;;; TODO: Implement directly in (gnu services configuration), perhaps by
;;; making the FIELDS argument optional.
@@ -215,11 +295,19 @@ (define fields (greeter-configuration->greeter-fields config))
(define (greeter-configuration->conf-name config)
"Return the file name of CONFIG, a greeter configuration."
- (format #f "~a.conf" (greeter-configuration->greeter-session config)))
+ (greeter-configuration-field config 'greeter-config-name))
(define (greeter-configuration->file config)
"Serialize CONFIG into a file under the output directory, so that it can be
easily added to XDG_CONF_DIRS."
+ (let* ((type-name (config->type-name config))
+ (func-name (string->symbol
+ (string-append
+ "greeter-configuration->file/" type-name)))
+ (eval-env (greeter-configuration-field config 'local-eval-environment)))
+ (local-eval `(,func-name ,config) eval-env)))
+
+(define (greeter-configuration->file/lightdm-gtk-greeter-configuration config)
(computed-file
(greeter-configuration->conf-name config)
#~(begin
@@ -229,6 +317,23 @@ (define (greeter-configuration->file config)
"[greeter]\n"
#$(serialize-configuration* config))))))))
+(define (greeter-configuration->file/lightdm-greeter-general-configuration config)
+ (computed-file
+ (greeter-configuration->conf-name config)
+ #~(begin
+ (call-with-output-file #$output
+ (lambda (port)
+ (format port #$(serialize-configuration* config)))))))
+
+(define (greeter-configuration-valid? config)
+ "Check greeter-configuration CONFIG valid or not."
+ (let ((conf-name (greeter-configuration->conf-name config))
+ (session-name (greeter-configuration->session-name config)))
+ (and (string? conf-name)
+ (string? session-name)
+ (> (string-length conf-name) 0)
+ (> (string-length session-name) 0))))
+
;;;
;;; Seats.
@@ -248,15 +353,14 @@ (define (serialize-seat-type name value)
(define-maybe seat-type)
(define (greeter-session? value)
- (memq value '(lightdm-gtk-greeter)))
+ (and (symbol? value)
+ (string-contains (symbol->string value) "-greeter" )))
(define (serialize-greeter-session name value)
(format #f "~a=~a~%" name value))
(define-maybe greeter-session)
-(define-maybe string)
-
;;; Note: all the fields except for the seat name should be 'maybe's, since
;;; the real default value is set by the %lightdm-seat-default define later,
;;; and this avoids repeating ourselves in the serialized configuration file.
@@ -291,22 +395,6 @@ (define-configuration lightdm-seat-configuration
(list-of-strings '())
"Extra configuration values to append to the seat configuration section."))
-(define (greeter-session->greater-configuration-pred identifier)
- "Return the predicate to check if a configuration is of the type specifying
-a greeter identified by IDENTIFIER."
- (match identifier
- ;; Note: register any new greeter identifier here.
- ('lightdm-gtk-greeter
- lightdm-gtk-greeter-configuration?)))
-
-(define (greeter-configuration->greeter-session config)
- "Given CONFIG, a greeter configuration object, return its identifier,
-a symbol."
- (let ((suffix "-configuration")
- (greeter-conf-name (config->name config)))
- (string->symbol (string-drop-right (symbol->string greeter-conf-name)
- (string-length suffix)))))
-
(define list-of-seat-configurations?
(list-of lightdm-seat-configuration?))
@@ -316,20 +404,17 @@ (define list-of-seat-configurations?
;;;
(define (greeter-configuration? config)
- (or (lightdm-gtk-greeter-configuration? config)
- ;; Note: register any new greeter configuration here.
- ))
+ ((record-predicate (struct-vtable config)) config))
(define (list-of-greeter-configurations? greeter-configs)
(and ((list-of greeter-configuration?) greeter-configs)
;; Greeter configurations must also not be provided more than once.
- (let* ((types (map (compose record-type-name struct-vtable)
- greeter-configs))
- (dupes (filter (lambda (type)
- (< 1 (count (cut eq? type <>) types)))
- types)))
+ (let* ((conf-names (map greeter-configuration->conf-name greeter-configs))
+ (dupes (filter (lambda (conf-name)
+ (< 1 (count (cut eq? conf-name <>) conf-names)))
+ conf-names)))
(unless (null? dupes)
- (leave (G_ "duplicate greeter configurations: ~a~%") dupes)))))
+ (leave (G_ "Duplicate greeter configurations: ~a~%") dupes)))))
(define-configuration/no-serialization lightdm-configuration
(lightdm
@@ -347,7 +432,9 @@ (define-configuration/no-serialization lightdm-configuration
start script. It can be refined per seat via the @code{xserver-command} of
the @code{<lightdm-seat-configuration>} record, if desired.")
(greeters
- (list-of-greeter-configurations (list (lightdm-gtk-greeter-configuration)))
+ (list-of-greeter-configurations
+ (list (lightdm-gtk-greeter-configuration)
+ (lightdm-greeter-general-configuration)))
"The LightDM greeter configurations specifying the greeters to use.")
(seats
(list-of-seat-configurations (list (lightdm-seat-configuration
@@ -417,8 +504,11 @@ (define (validate-lightdm-configuration config)
(missing-greeters
(filter-map
(lambda (id)
- (define pred (greeter-session->greater-configuration-pred id))
- (if (find pred greeter-configurations)
+ (if (find (lambda (greeter-config)
+ (let* ((id (symbol->string id))
+ (name (greeter-configuration->session-name greeter-config)))
+ (equal? id name)))
+ greeter-configurations)
#f ;happy path
id))
greeter-sessions)))
@@ -428,10 +518,11 @@ (define pred (greeter-session->greater-configuration-pred id))
(define (lightdm-configuration-file config)
(match-record config <lightdm-configuration>
- (xorg-configuration seats
- xdmcp? xdmcp-listen-address
- vnc-server? vnc-server-command vnc-server-listen-address vnc-server-port
- extra-config)
+ (xorg-configuration
+ seats xdmcp? xdmcp-listen-address
+ vnc-server? vnc-server-command
+ vnc-server-listen-address vnc-server-port
+ extra-config)
(apply
mixed-text-file
"lightdm.conf" "
@@ -470,22 +561,22 @@ (define (lightdm-configuration-file config)
# Seat configuration.
#
"
- (map (lambda (seat)
- ;; This complication exists to propagate a default value for
- ;; the 'xserver-command' field of the seats. Having a
- ;; 'xorg-configuration' field at the root of the
- ;; lightdm-configuration enables the use of
- ;; 'set-xorg-configuration' and can be more convenient.
- (let ((seat* (if (maybe-value-set?
- (lightdm-seat-configuration-xserver-command seat))
- seat
- (lightdm-seat-configuration
- (inherit seat)
- (xserver-command (xorg-start-command
- xorg-configuration))))))
- (serialize-configuration seat*
- lightdm-seat-configuration-fields)))
- seats))))
+ (map (lambda (seat)
+ ;; This complication exists to propagate a default value for
+ ;; the 'xserver-command' field of the seats. Having a
+ ;; 'xorg-configuration' field at the root of the
+ ;; lightdm-configuration enables the use of
+ ;; 'set-xorg-configuration' and can be more convenient.
+ (let ((seat* (if (maybe-value-set?
+ (lightdm-seat-configuration-xserver-command seat))
+ seat
+ (lightdm-seat-configuration
+ (inherit seat)
+ (xserver-command (xorg-start-command
+ xorg-configuration))))))
+ (serialize-configuration seat*
+ lightdm-seat-configuration-fields)))
+ seats))))
(define (lightdm-configuration-directory config)
"Return a directory containing the serialized lightdm configuration
@@ -495,7 +586,8 @@ (define (lightdm-configuration-directory config)
(map (lambda (g)
`(,(greeter-configuration->conf-name g)
,(greeter-configuration->file g)))
- (lightdm-configuration-greeters config)))))
+ (filter greeter-configuration-valid?
+ (lightdm-configuration-greeters config))))))
(define %lightdm-accounts
(list (user-group (name "lightdm") (system? #t))
@@ -676,4 +768,5 @@ (define lightdm-service-type
(define (generate-doc)
(configuration->documentation 'lightdm-configuration)
(configuration->documentation 'lightdm-gtk-greeter-configuration)
+ (configuration->documentation 'lightdm-greeter-general-configuration)
(configuration->documentation 'lightdm-seat-configuration))
--
2.45.2
--
guix-patches@HIDDEN:bug#75048; Package guix-patches.
Full text available.
Received: (at 75048) by debbugs.gnu.org; 24 Dec 2024 01:08:53 +0000
From debbugs-submit-bounces <at> debbugs.gnu.org Mon Dec 23 20:08:53 2024
Received: from localhost ([127.0.0.1]:58633 helo=debbugs.gnu.org)
by debbugs.gnu.org with esmtp (Exim 4.84_2)
(envelope-from <debbugs-submit-bounces <at> debbugs.gnu.org>)
id 1tPtPn-0006VO-Vo
for submit <at> debbugs.gnu.org; Mon, 23 Dec 2024 20:08:53 -0500
Received: from m16.mail.163.com ([220.197.31.3]:54410)
by debbugs.gnu.org with esmtp (Exim 4.84_2)
(envelope-from <tumashu@HIDDEN>) id 1tPtPi-0006V8-0Z
for 75048 <at> debbugs.gnu.org; Mon, 23 Dec 2024 20:08:50 -0500
DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=163.com;
s=s110527; h=From:Subject:Date:Message-ID:MIME-Version:
Content-Type; bh=06xrFYu5MF/gm9VwN1wAWl8t0lX/ZDkjX03b2GiYUf4=;
b=CX4V+411We/ubVJg0XEfa4cBmP4U2PDbEPqJWmNP5njuFYKBreZj9dx8el5jzB
H8iUFYx2G93kzmr2NlVdrKeH4EfmbY3o41znGncoMRIxLn9+NwSaC2yKab0A0V2T
vNgV16vd72r5gfqqc88jVHF1/bdz1ZOnElctMLFzm+dU4=
Received: from Tumashu (unknown [])
by gzga-smtp-mtada-g1-3 (Coremail) with SMTP id
_____wCHn6mWCWpny_EKBQ--.41238S2;
Tue, 24 Dec 2024 09:08:38 +0800 (CST)
From: Feng Shu <tumashu@HIDDEN>
To: 75048 <at> debbugs.gnu.org
Subject: [PATCH v2] Add lightdm-greeter-general-configuration and do not
hard code config type name everywhere.
Date: Tue, 24 Dec 2024 09:08:38 +0800
Message-ID: <87h66topk9.fsf@HIDDEN>
User-Agent: Gnus/5.13 (Gnus v5.13)
MIME-Version: 1.0
Content-Type: text/plain
X-CM-TRANSID: _____wCHn6mWCWpny_EKBQ--.41238S2
X-Coremail-Antispam: 1Uf129KBjvAXoWfXFy3Zr4DAr15Zry5Gw4UJwb_yoW8tw1Uuo
Z3ZFZrGr47Cr17WFnayr1fCr47Jryv9r48Zr18JryUAw1vqF43Ja4YvayUZF42kr4jkrn8
Gr95u39xAayqyF4rn29KB7ZKAUJUUUU8529EdanIXcx71UUUUU7v73VFW2AGmfu7bjvjm3
AaLaJ3UbIYCTnIWIevJa73UjIFyTuYvjxU0BTYDUUUU
X-Originating-IP: [218.92.14.78]
X-CM-SenderInfo: 5wxpt2lkx6il2tof0z/1tbiRRm-1GdqBK6k7gAAsa
X-Spam-Score: 0.0 (/)
X-Debbugs-Envelope-To: 75048
X-BeenThere: debbugs-submit <at> debbugs.gnu.org
X-Mailman-Version: 2.1.18
Precedence: list
List-Id: <debbugs-submit.debbugs.gnu.org>
List-Unsubscribe: <https://debbugs.gnu.org/cgi-bin/mailman/options/debbugs-submit>,
<mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=unsubscribe>
List-Archive: <https://debbugs.gnu.org/cgi-bin/mailman/private/debbugs-submit/>
List-Post: <mailto:debbugs-submit <at> debbugs.gnu.org>
List-Help: <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=help>
List-Subscribe: <https://debbugs.gnu.org/cgi-bin/mailman/listinfo/debbugs-submit>,
<mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=subscribe>
Errors-To: debbugs-submit-bounces <at> debbugs.gnu.org
Sender: "Debbugs-submit" <debbugs-submit-bounces <at> debbugs.gnu.org>
X-Spam-Score: -1.0 (-)
From 4bfdb9f1db0c0c23d57c68691f0fe36d6e3823f4 Mon Sep 17 00:00:00 2001
From: Feng Shu <tumashu@HIDDEN>
Date: Mon, 23 Dec 2024 19:30:28 +0800
Subject: [PATCH v2] Add lightdm-greeter-general-configuration and do not hard
code config type name everywhere.
* gnu/services/lightdm.scm (gnu): Use (ice-9 local-eval), export new option variables.
(local-eval-environment?): New variable.
(string): Move.
(lightdm-gtk-greeter-configuration): Add local-eval-environment,
greeter-session-name, greeter-package, greeter-config-name fields.
(lightdm-greeter-general-configuration): New variable.
(strip-record-type-name-brackets): Return string instead symbol.
(config->type-name): Rename from config->name.
(greeter-configuration-field): New function.
(greeter-configuration->greeter-fields): Do not hard code greeter configuation name.
(greeter-configuration->packages): Do not hard code greeter configuation name.
(greeter-configuration->conf-name): Improve.
(greeter-configuration->session-name): New variable.
(greeter-configuration->file): Call different function based config type.
(greeter-configuration->file/lightdm-gtk-greeter-configuration)
(greeter-configuration->file/lightdm-greeter-general-configuration): New functions.
(greeter-configuration-valid?): New function.
(greeter-session?): Do not hard code greeter configuation name.
(greeter-session->greater-configuration-pred)
(greeter-configuration->greeter-session): Removed.
(greeter-configuration?): Do not hard code greeter configuation name.
(lightdm-configuration): Add lightdm-greeter-general-configuration.
(validate-lightdm-configuration): Do not use greeter-session->greater-configuration-pred.
(generate-doc): Handle lightdm-greeter-general-configuration.
* doc/guix.texi (X Window): Improve lightdm-gtk-greeter-configuration options
doc, Add lightdm-greeter-general-configuration,
Change-Id: Iae22cd641454c86280e88d6986594ad0c8f4c490
---
doc/guix.texi | 94 ++++++++++++++++-
gnu/services/lightdm.scm | 221 +++++++++++++++++++++++++++------------
2 files changed, 246 insertions(+), 69 deletions(-)
diff --git a/doc/guix.texi b/doc/guix.texi
index 31deb5b003..e1f1fee68b 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -23802,8 +23802,7 @@ In its most basic form, it can be used simply as:
(service lightdm-service-type)
@end lisp
-A more elaborate example making use of the VNC capabilities and enabling
-more features and verbose logs could look like:
+Two more elaborate examples look like below:
@lisp
(service lightdm-service-type
@@ -23819,6 +23818,38 @@ more features and verbose logs could look like:
(name "*")
(user-session "ratpoison"))))))
@end lisp
+
+@lisp
+(service lightdm-service-type
+ (lightdm-configuration
+ (greeters
+ (list (lightdm-greeter-general-configuration
+ (greeter-package lightdm-mini-greeter)
+ (greeter-session-name "lightdm-mini-greeter")
+ (greeter-config-name "lightdm-mini-greeter.conf")
+ (config (list "[greeter]"
+ "user = guest")))
+ (lightdm-gtk-greeter-configuration
+ (extra-config
+ (list "font-name = San 10"
+ "xft-dpi = 140"
+ "clock-format = %Y-%m-%d %H:%M"
+ ;; We need to use "~~" to generate a tilde, for
+ ;; extra-config sting will be handle as
+ ;; control-string of format function.
+ "indicators = ~~host;~~spacer;~~session;~~a11y;~~clock;~~power")))))
+ (seats
+ (list (lightdm-seat-configuration
+ (name "*")
+ (greeter-session 'lightdm-mini-greeter))))
+ (xorg-configuration
+ (xorg-configuration
+ (server-arguments
+ (append %default-xorg-server-arguments
+ '("-dpi" "140")))))))
+@end lisp
+
+
@end defvar
@c The LightDM service documentation can be auto-generated via the
@@ -23903,8 +23934,21 @@ Extra configuration values to append to the LightDM configuration file.
Available @code{lightdm-gtk-greeter-configuration} fields are:
@table @asis
+@item @code{local-eval-environment} (default: @code{(the-environment)}) (type: local-eval-environment)
+Recode the environment where lightdm-gtk-greeter-configuration is defined.
+
@item @code{lightdm-gtk-greeter} (default: @code{lightdm-gtk-greeter}) (type: file-like)
-The lightdm-gtk-greeter package to use.
+The lightdm-gtk-greeter package to use, this option is keeped for
+compatibility, use greeter-package instead.
+
+@item @code{greeter-package} (default: @code{lightdm-gtk-greeter}) (type: file-like)
+The greeter package to use.
+
+@item @code{greeter-session-name} (default: @code{lightdm-gtk-greeter}) (type: string)
+The session name used in lightdm.conf.
+
+@item @code{greeter-config-name} (default: @code{lightdm-gtk-greeter.conf}) (type: string)
+The greeter config file name in /etc/lightdm directory.
@item @code{assets} (default: @code{(adwaita-icon-theme gnome-themes-extra hicolor-icon-theme)}) (type: list-of-file-likes)
The list of packages complementing the greeter, such as package
@@ -23948,6 +23992,50 @@ configuration file.
@c %end of fragment
@c %start of fragment
+@deftp {Data Type} lightdm-greeter-general-configuration
+
+@code{lightdm-greeter-general-configuration} support all text config
+greeters which have no build-in configuration type like
+@code{lightdm-gtk-greeter-configuration}, such as lightdm-mini-greeter,
+for example:
+
+@lisp
+(lightdm-greeter-general-configuration
+ (greeter-package lightdm-mini-greeter)
+ (greeter-session-name "lightdm-mini-greeter")
+ (greeter-config-name "lightdm-mini-greeter.conf")
+ (config (list "[greeter]"
+ "user = guest")))
+@end lisp
+
+Available @code{lightdm-greeter-general-configuration} fields are:
+
+@table @asis
+@item @code{local-eval-environment} (default: @code{(the-environment)}) (type: local-eval-environment)
+Recode the environment where lightdm-greeter-general-configuration is defined.
+
+@item @code{greeter-package} (type: maybe-file-like)
+The greeter package to use.
+
+@item @code{greeter-session-name} (type: maybe-string)
+The session name used in lightdm.conf.
+
+@item @code{greeter-config-name} (type: maybe-string)
+The greeter config file name in /etc/lightdm directory.
+
+@item @code{assets} (default: @code{(adwaita-icon-theme gnome-themes-extra hicolor-icon-theme)}) (type: list-of-file-likes)
+The list of packages complementing the greeter, such as package
+providing icon themes.
+
+@item @code{config} (default: @code{'()}) (type: list-of-strings)
+Configuration values of the LightDM Greeter configuration file.
+
+@end table
+@end deftp
+
+@c %end of fragment
+@c %start of fragment
+
@deftp {Data Type} lightdm-seat-configuration
Available @code{lightdm-seat-configuration} fields are:
diff --git a/gnu/services/lightdm.scm b/gnu/services/lightdm.scm
index 191cb5635b..035ea41c70 100644
--- a/gnu/services/lightdm.scm
+++ b/gnu/services/lightdm.scm
@@ -39,6 +39,7 @@ (define-module (gnu services lightdm)
#:use-module (guix i18n)
#:use-module (guix records)
#:use-module (ice-9 format)
+ #:use-module (ice-9 local-eval)
#:use-module (ice-9 match)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-26)
@@ -56,7 +57,10 @@ (define-module (gnu services lightdm)
lightdm-gtk-greeter-configuration
lightdm-gtk-greeter-configuration?
lightdm-gtk-greeter-configuration-lightdm-gtk-greeter
+ lightdm-gtk-greeter-configuration-greeter-package
lightdm-gtk-greeter-configuration-assets
+ lightdm-gtk-greeter-configuration-greeter-config-name
+ lightdm-gtk-greeter-configuration-greeter-session-name
lightdm-gtk-greeter-configuration-theme-name
lightdm-gtk-greeter-configuration-icon-theme-name
lightdm-gtk-greeter-configuration-cursor-theme-name
@@ -66,6 +70,14 @@ (define-module (gnu services lightdm)
lightdm-gtk-greeter-configuration-reader
lightdm-gtk-greeter-configuration-extra-config
+ lightdm-greeter-general-configuration
+ lightdm-greeter-general-configuration?
+ lightdm-greeter-general-configuration-greeter-package
+ lightdm-greeter-general-configuration-assets
+ lightdm-greeter-general-configuration-greeter-config-name
+ lightdm-greeter-general-configuration-greeter-session-name
+ lightdm-greeter-general-configuration-config
+
lightdm-configuration
lightdm-configuration?
lightdm-configuration-lightdm
@@ -87,6 +99,9 @@ (define-module (gnu services lightdm)
;;; Greeters.
;;;
+(define (local-eval-environment? value)
+ #t)
+
(define list-of-file-likes?
(list-of file-like?))
@@ -117,6 +132,8 @@ (define (serialize-file-like name value)
(define (serialize-list-of-a11y-states name value)
(format #f "~a=~a~%" name (string-join (map symbol->string value) ";")))
+(define-maybe string)
+
(define (serialize-string name value)
(format #f "~a=~a~%" name value))
@@ -127,9 +144,21 @@ (define (serialize-list-of-strings _ value)
(string-join value "\n"))
(define-configuration lightdm-gtk-greeter-configuration
+ (local-eval-environment
+ (local-eval-environment (the-environment))
+ "Recode the environment where lightdm-gtk-greeter-configuration is defined."
+ empty-serializer)
+ (greeter-session-name
+ (string "lightdm-gtk-greeter")
+ "Session name used in lightdm.conf"
+ empty-serializer)
(lightdm-gtk-greeter
+ maybe-file-like
+ "Keep it for compatibility, use greeter-package field instead."
+ empty-serializer)
+ (greeter-package
(file-like lightdm-gtk-greeter)
- "The lightdm-gtk-greeter package to use."
+ "The greeter package to use."
empty-serializer)
(assets
(list-of-file-likes (list adwaita-icon-theme
@@ -140,6 +169,10 @@ (define-configuration lightdm-gtk-greeter-configuration
"The list of packages complementing the greeter, such as package providing
icon themes."
empty-serializer)
+ (greeter-config-name
+ (string "lightdm-gtk-greeter.conf")
+ "Greeter config file name in /etc/lightdm directory."
+ empty-serializer)
(theme-name
(string "Adwaita")
"The name of the theme to use.")
@@ -176,34 +209,77 @@ (define-configuration lightdm-gtk-greeter-configuration
"Extra configuration values to append to the LightDM GTK Greeter
configuration file."))
+(define-configuration lightdm-greeter-general-configuration
+ (local-eval-environment
+ (local-eval-environment (the-environment))
+ "Recode the environment where lightdm-greeter-general-configuration is defined."
+ empty-serializer)
+ (greeter-package
+ maybe-file-like
+ "The greeter package to use."
+ empty-serializer)
+ (assets
+ (list-of-file-likes (list adwaita-icon-theme
+ gnome-themes-extra
+ ;; FIXME: hicolor-icon-theme should be in the
+ ;; packages of the desktop templates.
+ hicolor-icon-theme))
+ "The list of packages complementing the greeter, such as package providing
+icon themes."
+ empty-serializer)
+ (greeter-config-name
+ maybe-string
+ "Greeter config file name in /etc/lightdm directory."
+ empty-serializer)
+ (greeter-session-name
+ maybe-string
+ "Session name used in lightdm.conf"
+ empty-serializer)
+ (config
+ (list-of-strings '())
+ "Configuration values of the LightDM Greeter configuration file."))
+
(define (strip-record-type-name-brackets name)
"Remove the '<' and '>' brackets from NAME, a symbol."
(let ((name (symbol->string name)))
(if (and (string-prefix? "<" name)
(string-suffix? ">" name))
- (string->symbol (string-drop (string-drop-right name 1) 1))
+ (string-drop (string-drop-right name 1) 1)
(error "unexpected record type name" name))))
-(define (config->name config)
- "Return the constructor name (a symbol) from CONFIG."
+(define (config->type-name config)
+ "Return the type name of CONFIG."
(strip-record-type-name-brackets
(record-type-name (struct-vtable config))))
+(define (greeter-configuration-field config field)
+ "Return field value of config."
+ (let ((rtd (struct-vtable config)))
+ ((record-accessor rtd field) config)))
+
+(define (greeter-configuration->session-name config)
+ "Return the session name of CONFIG, a greeter configuration."
+ (greeter-configuration-field config 'greeter-session-name))
+
(define (greeter-configuration->greeter-fields config)
"Return the fields of CONFIG, a greeter configuration."
- (match config
- ;; Note: register any new greeter configuration here.
- ((? lightdm-gtk-greeter-configuration?)
- lightdm-gtk-greeter-configuration-fields)))
+ (let* ((type-name (config->type-name config))
+ (variable (string->symbol (string-append type-name "-fields")))
+ (eval-env (greeter-configuration-field config 'local-eval-environment)))
+ (local-eval variable eval-env)))
(define (greeter-configuration->packages config)
"Return the list of greeter packages, including assets, used by CONFIG, a
greeter configuration."
- (match config
- ;; Note: register any new greeter configuration here.
- ((? lightdm-gtk-greeter-configuration?)
- (cons (lightdm-gtk-greeter-configuration-lightdm-gtk-greeter config)
- (lightdm-gtk-greeter-configuration-assets config)))))
+ (filter file-like?
+ (cons
+ (if (eq? (config->type-name config) 'lightdm-gtk-greeter-configuration)
+ ;; Handle lightdm-gtk-greeter field for keeping it for compatibility.
+ (if (file-like? (greeter-configuration-field config 'lightdm-gtk-greeter))
+ (greeter-configuration-field config 'lightdm-gtk-greeter)
+ (greeter-configuration-field config 'greeter-package))
+ (greeter-configuration-field config 'greeter-package))
+ (greeter-configuration-field config 'assets))))
;;; TODO: Implement directly in (gnu services configuration), perhaps by
;;; making the FIELDS argument optional.
@@ -215,11 +291,19 @@ (define fields (greeter-configuration->greeter-fields config))
(define (greeter-configuration->conf-name config)
"Return the file name of CONFIG, a greeter configuration."
- (format #f "~a.conf" (greeter-configuration->greeter-session config)))
+ (greeter-configuration-field config 'greeter-config-name))
(define (greeter-configuration->file config)
"Serialize CONFIG into a file under the output directory, so that it can be
easily added to XDG_CONF_DIRS."
+ (let* ((type-name (config->type-name config))
+ (func-name (string->symbol
+ (string-append
+ "greeter-configuration->file/" type-name)))
+ (eval-env (greeter-configuration-field config 'local-eval-environment)))
+ (local-eval `(,func-name ,config) eval-env)))
+
+(define (greeter-configuration->file/lightdm-gtk-greeter-configuration config)
(computed-file
(greeter-configuration->conf-name config)
#~(begin
@@ -229,6 +313,23 @@ (define (greeter-configuration->file config)
"[greeter]\n"
#$(serialize-configuration* config))))))))
+(define (greeter-configuration->file/lightdm-greeter-general-configuration config)
+ (computed-file
+ (greeter-configuration->conf-name config)
+ #~(begin
+ (call-with-output-file #$output
+ (lambda (port)
+ (format port #$(serialize-configuration* config)))))))
+
+(define (greeter-configuration-valid? config)
+ "Check greeter-configuration CONFIG valid or not."
+ (let ((conf-name (greeter-configuration->conf-name config))
+ (session-name (greeter-configuration->session-name config)))
+ (and (string? conf-name)
+ (string? session-name)
+ (> (string-length conf-name) 0)
+ (> (string-length session-name) 0))))
+
;;;
;;; Seats.
@@ -248,15 +349,14 @@ (define (serialize-seat-type name value)
(define-maybe seat-type)
(define (greeter-session? value)
- (memq value '(lightdm-gtk-greeter)))
+ (and (symbol? value)
+ (string-contains (symbol->string value) "-greeter" )))
(define (serialize-greeter-session name value)
(format #f "~a=~a~%" name value))
(define-maybe greeter-session)
-(define-maybe string)
-
;;; Note: all the fields except for the seat name should be 'maybe's, since
;;; the real default value is set by the %lightdm-seat-default define later,
;;; and this avoids repeating ourselves in the serialized configuration file.
@@ -291,22 +391,6 @@ (define-configuration lightdm-seat-configuration
(list-of-strings '())
"Extra configuration values to append to the seat configuration section."))
-(define (greeter-session->greater-configuration-pred identifier)
- "Return the predicate to check if a configuration is of the type specifying
-a greeter identified by IDENTIFIER."
- (match identifier
- ;; Note: register any new greeter identifier here.
- ('lightdm-gtk-greeter
- lightdm-gtk-greeter-configuration?)))
-
-(define (greeter-configuration->greeter-session config)
- "Given CONFIG, a greeter configuration object, return its identifier,
-a symbol."
- (let ((suffix "-configuration")
- (greeter-conf-name (config->name config)))
- (string->symbol (string-drop-right (symbol->string greeter-conf-name)
- (string-length suffix)))))
-
(define list-of-seat-configurations?
(list-of lightdm-seat-configuration?))
@@ -316,20 +400,17 @@ (define list-of-seat-configurations?
;;;
(define (greeter-configuration? config)
- (or (lightdm-gtk-greeter-configuration? config)
- ;; Note: register any new greeter configuration here.
- ))
+ ((record-predicate (struct-vtable config)) config))
(define (list-of-greeter-configurations? greeter-configs)
(and ((list-of greeter-configuration?) greeter-configs)
;; Greeter configurations must also not be provided more than once.
- (let* ((types (map (compose record-type-name struct-vtable)
- greeter-configs))
- (dupes (filter (lambda (type)
- (< 1 (count (cut eq? type <>) types)))
- types)))
+ (let* ((conf-names (map greeter-configuration->conf-name greeter-configs))
+ (dupes (filter (lambda (conf-name)
+ (< 1 (count (cut eq? conf-name <>) conf-names)))
+ conf-names)))
(unless (null? dupes)
- (leave (G_ "duplicate greeter configurations: ~a~%") dupes)))))
+ (leave (G_ "Duplicate greeter configurations: ~a~%") dupes)))))
(define-configuration/no-serialization lightdm-configuration
(lightdm
@@ -347,7 +428,9 @@ (define-configuration/no-serialization lightdm-configuration
start script. It can be refined per seat via the @code{xserver-command} of
the @code{<lightdm-seat-configuration>} record, if desired.")
(greeters
- (list-of-greeter-configurations (list (lightdm-gtk-greeter-configuration)))
+ (list-of-greeter-configurations
+ (list (lightdm-gtk-greeter-configuration)
+ (lightdm-greeter-general-configuration)))
"The LightDM greeter configurations specifying the greeters to use.")
(seats
(list-of-seat-configurations (list (lightdm-seat-configuration
@@ -417,8 +500,11 @@ (define (validate-lightdm-configuration config)
(missing-greeters
(filter-map
(lambda (id)
- (define pred (greeter-session->greater-configuration-pred id))
- (if (find pred greeter-configurations)
+ (if (find (lambda (greeter-config)
+ (let* ((id (symbol->string id))
+ (name (greeter-configuration->session-name greeter-config)))
+ (equal? id name)))
+ greeter-configurations)
#f ;happy path
id))
greeter-sessions)))
@@ -428,10 +514,11 @@ (define pred (greeter-session->greater-configuration-pred id))
(define (lightdm-configuration-file config)
(match-record config <lightdm-configuration>
- (xorg-configuration seats
- xdmcp? xdmcp-listen-address
- vnc-server? vnc-server-command vnc-server-listen-address vnc-server-port
- extra-config)
+ (xorg-configuration
+ seats xdmcp? xdmcp-listen-address
+ vnc-server? vnc-server-command
+ vnc-server-listen-address vnc-server-port
+ extra-config)
(apply
mixed-text-file
"lightdm.conf" "
@@ -470,22 +557,22 @@ (define (lightdm-configuration-file config)
# Seat configuration.
#
"
- (map (lambda (seat)
- ;; This complication exists to propagate a default value for
- ;; the 'xserver-command' field of the seats. Having a
- ;; 'xorg-configuration' field at the root of the
- ;; lightdm-configuration enables the use of
- ;; 'set-xorg-configuration' and can be more convenient.
- (let ((seat* (if (maybe-value-set?
- (lightdm-seat-configuration-xserver-command seat))
- seat
- (lightdm-seat-configuration
- (inherit seat)
- (xserver-command (xorg-start-command
- xorg-configuration))))))
- (serialize-configuration seat*
- lightdm-seat-configuration-fields)))
- seats))))
+ (map (lambda (seat)
+ ;; This complication exists to propagate a default value for
+ ;; the 'xserver-command' field of the seats. Having a
+ ;; 'xorg-configuration' field at the root of the
+ ;; lightdm-configuration enables the use of
+ ;; 'set-xorg-configuration' and can be more convenient.
+ (let ((seat* (if (maybe-value-set?
+ (lightdm-seat-configuration-xserver-command seat))
+ seat
+ (lightdm-seat-configuration
+ (inherit seat)
+ (xserver-command (xorg-start-command
+ xorg-configuration))))))
+ (serialize-configuration seat*
+ lightdm-seat-configuration-fields)))
+ seats))))
(define (lightdm-configuration-directory config)
"Return a directory containing the serialized lightdm configuration
@@ -495,7 +582,8 @@ (define (lightdm-configuration-directory config)
(map (lambda (g)
`(,(greeter-configuration->conf-name g)
,(greeter-configuration->file g)))
- (lightdm-configuration-greeters config)))))
+ (filter greeter-configuration-valid?
+ (lightdm-configuration-greeters config))))))
(define %lightdm-accounts
(list (user-group (name "lightdm") (system? #t))
@@ -676,4 +764,5 @@ (define lightdm-service-type
(define (generate-doc)
(configuration->documentation 'lightdm-configuration)
(configuration->documentation 'lightdm-gtk-greeter-configuration)
+ (configuration->documentation 'lightdm-greeter-general-configuration)
(configuration->documentation 'lightdm-seat-configuration))
--
2.45.2
--
guix-patches@HIDDEN:bug#75048; Package guix-patches.
Full text available.
Received: (at submit) by debbugs.gnu.org; 23 Dec 2024 13:21:17 +0000
From debbugs-submit-bounces <at> debbugs.gnu.org Mon Dec 23 08:21:17 2024
Received: from localhost ([127.0.0.1]:53721 helo=debbugs.gnu.org)
by debbugs.gnu.org with esmtp (Exim 4.84_2)
(envelope-from <debbugs-submit-bounces <at> debbugs.gnu.org>)
id 1tPiN2-00055B-Iz
for submit <at> debbugs.gnu.org; Mon, 23 Dec 2024 08:21:17 -0500
Received: from lists.gnu.org ([209.51.188.17]:34758)
by debbugs.gnu.org with esmtp (Exim 4.84_2)
(envelope-from <tumashu@HIDDEN>) id 1tPiMy-00054x-0M
for submit <at> debbugs.gnu.org; Mon, 23 Dec 2024 08:21:14 -0500
Received: from eggs.gnu.org ([2001:470:142:3::10])
by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256)
(Exim 4.90_1) (envelope-from <tumashu@HIDDEN>) id 1tPiKo-00026z-RN
for guix-patches@HIDDEN; Mon, 23 Dec 2024 08:18:59 -0500
Received: from m16.mail.163.com ([117.135.210.5])
by eggs.gnu.org with esmtp (Exim 4.90_1)
(envelope-from <tumashu@HIDDEN>) id 1tPiKh-0005B5-9p
for guix-patches@HIDDEN; Mon, 23 Dec 2024 08:18:58 -0500
DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=163.com;
s=s110527; h=From:Subject:Date:Message-ID:MIME-Version:
Content-Type; bh=y4WchLsuGnVlHo1esRnnSQOX6rTxCn6HCZV54J/GbWI=;
b=GGpNfyh6VegS0x5kWzuDH5P6rDT/RSYmDrnVy+GHjvVWP6/AEQHylnH3nqrH8y
FDd8wV/LfMtlpiOEQrjOL2yS2e+nCdL3hgxkakwMObtndTnlOmOAYpW4301k4ve6
sfjBRorQaoaMHho0IMZc+knJes/ZdgsX15WhMeMOipJVY=
Received: from Guix (unknown [])
by gzga-smtp-mtada-g1-3 (Coremail) with SMTP id
_____wAXaz4wY2lnouyiBA--.6911S2;
Mon, 23 Dec 2024 21:18:41 +0800 (CST)
From: Feng Shu <tumashu@HIDDEN>
To: guix-patches@HIDDEN
Subject: [PATCH] Add lightdm-greeter-general-configuration and do not hard
code config type name everywhere.
Date: Mon, 23 Dec 2024 21:18:40 +0800
Message-ID: <87pllibkr3.fsf@HIDDEN>
User-Agent: Gnus/5.13 (Gnus v5.13)
MIME-Version: 1.0
Content-Type: text/plain
X-CM-TRANSID: _____wAXaz4wY2lnouyiBA--.6911S2
X-Coremail-Antispam: 1Uf129KBjvAXoW3tw4kAr4DWrWfuFWftFy8Grg_yoW8CFWkAo
Z3ZFZrGr47Cr17WFnayrn3Cr47Jr9Y9w4xZr18JryUAw1vqF43Ja4Y9ay8ZF42kr4jkr98
Gr95u39xAFWqyF4rn29KB7ZKAUJUUUU8529EdanIXcx71UUUUU7v73VFW2AGmfu7bjvjm3
AaLaJ3UbIYCTnIWIevJa73UjIFyTuYvjxU1YFCDUUUU
X-Originating-IP: [117.92.136.108]
X-CM-SenderInfo: 5wxpt2lkx6il2tof0z/1tbiRRy+1GdpYLJFhgABst
Received-SPF: pass client-ip=117.135.210.5; envelope-from=tumashu@HIDDEN;
helo=m16.mail.163.com
X-Spam_score_int: -20
X-Spam_score: -2.1
X-Spam_bar: --
X-Spam_report: (-2.1 / 5.0 requ) BAYES_00=-1.9, DKIM_SIGNED=0.1,
DKIM_VALID=-0.1, DKIM_VALID_AU=-0.1, DKIM_VALID_EF=-0.1, FREEMAIL_FROM=0.001,
RCVD_IN_DNSWL_NONE=-0.0001, RCVD_IN_MSPIKE_H2=-0.001,
RCVD_IN_VALIDITY_RPBL_BLOCKED=0.001, RCVD_IN_VALIDITY_SAFE_BLOCKED=0.001,
SPF_HELO_NONE=0.001, SPF_PASS=-0.001,
UNPARSEABLE_RELAY=0.001 autolearn=ham autolearn_force=no
X-Spam_action: no action
X-Spam-Score: -1.4 (-)
X-Debbugs-Envelope-To: submit
X-BeenThere: debbugs-submit <at> debbugs.gnu.org
X-Mailman-Version: 2.1.18
Precedence: list
List-Id: <debbugs-submit.debbugs.gnu.org>
List-Unsubscribe: <https://debbugs.gnu.org/cgi-bin/mailman/options/debbugs-submit>,
<mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=unsubscribe>
List-Archive: <https://debbugs.gnu.org/cgi-bin/mailman/private/debbugs-submit/>
List-Post: <mailto:debbugs-submit <at> debbugs.gnu.org>
List-Help: <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=help>
List-Subscribe: <https://debbugs.gnu.org/cgi-bin/mailman/listinfo/debbugs-submit>,
<mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=subscribe>
Errors-To: debbugs-submit-bounces <at> debbugs.gnu.org
Sender: "Debbugs-submit" <debbugs-submit-bounces <at> debbugs.gnu.org>
X-Spam-Score: -2.4 (--)
From 0a49889ee8ceda8c311a12c9f1e1f44cecb3e100 Mon Sep 17 00:00:00 2001
From: Feng Shu <tumashu@HIDDEN>
Date: Mon, 23 Dec 2024 19:30:28 +0800
Subject: [PATCH] Add lightdm-greeter-general-configuration and do not hard
code config type name everywhere.
* gnu/services/lightdm.scm (gnu): Use (ice-9 local-eval), export new option variables.
(local-eval-environment?): New variable.
(string): Move.
(lightdm-gtk-greeter-configuration): Add local-eval-environment,
greeter-session-name, greeter-package, greeter-config-name fields.
(lightdm-greeter-general-configuration): New variable.
(strip-record-type-name-brackets): Return string instead symbol.
(config->type-name): Rename from config->name.
(greeter-configuration-field): New function.
(greeter-configuration->greeter-fields): Do not hard code greeter configuation name.
(greeter-configuration->packages): Do not hard code greeter configuation name.
(greeter-configuration->conf-name): Improve.
(greeter-configuration->file): Call different function based config type.
(greeter-configuration->file/lightdm-gtk-greeter-configuration)
(greeter-configuration->file/lightdm-greeter-general-configuration): New functions.
(greeter-session?): Do not hard code greeter configuation name.
(greeter-session->greater-configuration-pred)
(greeter-configuration->greeter-session): Removed.
(greeter-configuration?): Do not hard code greeter configuation name.
(lightdm-configuration): Add lightdm-greeter-general-configuration.
(validate-lightdm-configuration): Do not use greeter-session->greater-configuration-pred.
(generate-doc): Handle lightdm-greeter-general-configuration.
* doc/guix.texi (X Window): Improve lightdm-gtk-greeter-configuration options
doc, Add lightdm-greeter-general-configuration,
Change-Id: Iae22cd641454c86280e88d6986594ad0c8f4c490
---
doc/guix.texi | 94 ++++++++++++++++++++++-
gnu/services/lightdm.scm | 158 +++++++++++++++++++++++++++++----------
2 files changed, 210 insertions(+), 42 deletions(-)
diff --git a/doc/guix.texi b/doc/guix.texi
index f7b75698870..bfcb5780914 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -23799,8 +23799,7 @@ In its most basic form, it can be used simply as:
(service lightdm-service-type)
@end lisp
-A more elaborate example making use of the VNC capabilities and enabling
-more features and verbose logs could look like:
+Two more elaborate examples look like below:
@lisp
(service lightdm-service-type
@@ -23816,6 +23815,38 @@ more features and verbose logs could look like:
(name "*")
(user-session "ratpoison"))))))
@end lisp
+
+@lisp
+(service lightdm-service-type
+ (lightdm-configuration
+ (greeters
+ (list (lightdm-greeter-general-configuration
+ (greeter-package lightdm-mini-greeter)
+ (greeter-session-name "lightdm-mini-greeter")
+ (greeter-config-name "lightdm-mini-greeter.conf")
+ (config (list "[greeter]"
+ "user = guest")))
+ (lightdm-gtk-greeter-configuration
+ (extra-config
+ (list "font-name = San 10"
+ "xft-dpi = 140"
+ "clock-format = %Y-%m-%d %H:%M"
+ ;; We need to use "~~" to generate a tilde, for
+ ;; extra-config sting will be handle as
+ ;; control-string of format function.
+ "indicators = ~~host;~~spacer;~~session;~~a11y;~~clock;~~power")))))
+ (seats
+ (list (lightdm-seat-configuration
+ (name "*")
+ (greeter-session 'lightdm-mini-greeter))))
+ (xorg-configuration
+ (xorg-configuration
+ (server-arguments
+ (append %default-xorg-server-arguments
+ '("-dpi" "140")))))))
+@end lisp
+
+
@end defvar
@c The LightDM service documentation can be auto-generated via the
@@ -23900,8 +23931,21 @@ Extra configuration values to append to the LightDM configuration file.
Available @code{lightdm-gtk-greeter-configuration} fields are:
@table @asis
+@item @code{local-eval-environment} (default: @code{(the-environment)}) (type: local-eval-environment)
+Recode the environment where lightdm-gtk-greeter-configuration is defined.
+
@item @code{lightdm-gtk-greeter} (default: @code{lightdm-gtk-greeter}) (type: file-like)
-The lightdm-gtk-greeter package to use.
+The lightdm-gtk-greeter package to use, this option is keeped for
+compatibility, use greeter-package instead.
+
+@item @code{greeter-package} (default: @code{lightdm-gtk-greeter}) (type: file-like)
+The greeter package to use.
+
+@item @code{greeter-session-name} (default: @code{lightdm-gtk-greeter}) (type: string)
+The session name used in lightdm.conf.
+
+@item @code{greeter-config-name} (default: @code{lightdm-gtk-greeter.conf}) (type: string)
+The greeter config file name in /etc/lightdm directory.
@item @code{assets} (default: @code{(adwaita-icon-theme gnome-themes-extra hicolor-icon-theme)}) (type: list-of-file-likes)
The list of packages complementing the greeter, such as package
@@ -23945,6 +23989,50 @@ configuration file.
@c %end of fragment
@c %start of fragment
+@deftp {Data Type} lightdm-greeter-general-configuration
+
+@code{lightdm-greeter-general-configuration} support all text config
+greeters which have no build-in configuration type like
+@code{lightdm-gtk-greeter-configuration}, such as lightdm-mini-greeter,
+for example:
+
+@lisp
+(lightdm-greeter-general-configuration
+ (greeter-package lightdm-mini-greeter)
+ (greeter-session-name "lightdm-mini-greeter")
+ (greeter-config-name "lightdm-mini-greeter.conf")
+ (config (list "[greeter]"
+ "user = guest")))
+@end lisp
+
+Available @code{lightdm-greeter-general-configuration} fields are:
+
+@table @asis
+@item @code{local-eval-environment} (default: @code{(the-environment)}) (type: local-eval-environment)
+Recode the environment where lightdm-greeter-general-configuration is defined.
+
+@item @code{greeter-package} (type: maybe-file-like)
+The greeter package to use.
+
+@item @code{greeter-session-name} (type: maybe-string)
+The session name used in lightdm.conf.
+
+@item @code{greeter-config-name} (type: maybe-string)
+The greeter config file name in /etc/lightdm directory.
+
+@item @code{assets} (default: @code{(adwaita-icon-theme gnome-themes-extra hicolor-icon-theme)}) (type: list-of-file-likes)
+The list of packages complementing the greeter, such as package
+providing icon themes.
+
+@item @code{config} (default: @code{'()}) (type: list-of-strings)
+Configuration values of the LightDM Greeter configuration file.
+
+@end table
+@end deftp
+
+@c %end of fragment
+@c %start of fragment
+
@deftp {Data Type} lightdm-seat-configuration
Available @code{lightdm-seat-configuration} fields are:
diff --git a/gnu/services/lightdm.scm b/gnu/services/lightdm.scm
index 191cb5635b1..8308d1b4f58 100644
--- a/gnu/services/lightdm.scm
+++ b/gnu/services/lightdm.scm
@@ -39,6 +39,7 @@ (define-module (gnu services lightdm)
#:use-module (guix i18n)
#:use-module (guix records)
#:use-module (ice-9 format)
+ #:use-module (ice-9 local-eval)
#:use-module (ice-9 match)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-26)
@@ -56,7 +57,10 @@ (define-module (gnu services lightdm)
lightdm-gtk-greeter-configuration
lightdm-gtk-greeter-configuration?
lightdm-gtk-greeter-configuration-lightdm-gtk-greeter
+ lightdm-gtk-greeter-configuration-greeter-package
lightdm-gtk-greeter-configuration-assets
+ lightdm-gtk-greeter-configuration-greeter-config-name
+ lightdm-gtk-greeter-configuration-greeter-session-name
lightdm-gtk-greeter-configuration-theme-name
lightdm-gtk-greeter-configuration-icon-theme-name
lightdm-gtk-greeter-configuration-cursor-theme-name
@@ -66,6 +70,14 @@ (define-module (gnu services lightdm)
lightdm-gtk-greeter-configuration-reader
lightdm-gtk-greeter-configuration-extra-config
+ lightdm-greeter-general-configuration
+ lightdm-greeter-general-configuration?
+ lightdm-greeter-general-configuration-greeter-package
+ lightdm-greeter-general-configuration-assets
+ lightdm-greeter-general-configuration-greeter-config-name
+ lightdm-greeter-general-configuration-greeter-session-name
+ lightdm-greeter-general-configuration-config
+
lightdm-configuration
lightdm-configuration?
lightdm-configuration-lightdm
@@ -87,6 +99,9 @@ (define-module (gnu services lightdm)
;;; Greeters.
;;;
+(define (local-eval-environment? value)
+ #t)
+
(define list-of-file-likes?
(list-of file-like?))
@@ -117,6 +132,8 @@ (define (serialize-file-like name value)
(define (serialize-list-of-a11y-states name value)
(format #f "~a=~a~%" name (string-join (map symbol->string value) ";")))
+(define-maybe string)
+
(define (serialize-string name value)
(format #f "~a=~a~%" name value))
@@ -127,9 +144,21 @@ (define (serialize-list-of-strings _ value)
(string-join value "\n"))
(define-configuration lightdm-gtk-greeter-configuration
+ (local-eval-environment
+ (local-eval-environment (the-environment))
+ "Recode the environment where lightdm-gtk-greeter-configuration is defined."
+ empty-serializer)
+ (greeter-session-name
+ (string "lightdm-gtk-greeter")
+ "Session name used in lightdm.conf"
+ empty-serializer)
(lightdm-gtk-greeter
+ maybe-file-like
+ "Keep it for compatibility, use greeter-package field instead."
+ empty-serializer)
+ (greeter-package
(file-like lightdm-gtk-greeter)
- "The lightdm-gtk-greeter package to use."
+ "The greeter package to use."
empty-serializer)
(assets
(list-of-file-likes (list adwaita-icon-theme
@@ -140,6 +169,10 @@ (define-configuration lightdm-gtk-greeter-configuration
"The list of packages complementing the greeter, such as package providing
icon themes."
empty-serializer)
+ (greeter-config-name
+ (string "lightdm-gtk-greeter.conf")
+ "Greeter config file name in /etc/lightdm directory."
+ empty-serializer)
(theme-name
(string "Adwaita")
"The name of the theme to use.")
@@ -176,34 +209,73 @@ (define-configuration lightdm-gtk-greeter-configuration
"Extra configuration values to append to the LightDM GTK Greeter
configuration file."))
+(define-configuration lightdm-greeter-general-configuration
+ (local-eval-environment
+ (local-eval-environment (the-environment))
+ "Recode the environment where lightdm-greeter-general-configuration is defined."
+ empty-serializer)
+ (greeter-package
+ maybe-file-like
+ "The greeter package to use."
+ empty-serializer)
+ (assets
+ (list-of-file-likes (list adwaita-icon-theme
+ gnome-themes-extra
+ ;; FIXME: hicolor-icon-theme should be in the
+ ;; packages of the desktop templates.
+ hicolor-icon-theme))
+ "The list of packages complementing the greeter, such as package providing
+icon themes."
+ empty-serializer)
+ (greeter-config-name
+ maybe-string
+ "Greeter config file name in /etc/lightdm directory."
+ empty-serializer)
+ (greeter-session-name
+ maybe-string
+ "Session name used in lightdm.conf"
+ empty-serializer)
+ (config
+ (list-of-strings '())
+ "Configuration values of the LightDM Greeter configuration file."))
+
(define (strip-record-type-name-brackets name)
"Remove the '<' and '>' brackets from NAME, a symbol."
(let ((name (symbol->string name)))
(if (and (string-prefix? "<" name)
(string-suffix? ">" name))
- (string->symbol (string-drop (string-drop-right name 1) 1))
+ (string-drop (string-drop-right name 1) 1)
(error "unexpected record type name" name))))
-(define (config->name config)
- "Return the constructor name (a symbol) from CONFIG."
+(define (config->type-name config)
+ "Return the type name of CONFIG."
(strip-record-type-name-brackets
(record-type-name (struct-vtable config))))
+(define (greeter-configuration-field config field)
+ "Return field value of config."
+ (let ((rtd (struct-vtable config)))
+ ((record-accessor rtd field) config)))
+
(define (greeter-configuration->greeter-fields config)
"Return the fields of CONFIG, a greeter configuration."
- (match config
- ;; Note: register any new greeter configuration here.
- ((? lightdm-gtk-greeter-configuration?)
- lightdm-gtk-greeter-configuration-fields)))
+ (let* ((type-name (config->type-name config))
+ (variable (string->symbol (string-append type-name "-fields")))
+ (eval-env (greeter-configuration-field config 'local-eval-environment)))
+ (local-eval variable eval-env)))
(define (greeter-configuration->packages config)
"Return the list of greeter packages, including assets, used by CONFIG, a
greeter configuration."
- (match config
- ;; Note: register any new greeter configuration here.
- ((? lightdm-gtk-greeter-configuration?)
- (cons (lightdm-gtk-greeter-configuration-lightdm-gtk-greeter config)
- (lightdm-gtk-greeter-configuration-assets config)))))
+ (filter file-like?
+ (cons
+ (if (eq? (config->type-name config) 'lightdm-gtk-greeter-configuration)
+ ;; Handle lightdm-gtk-greeter field for keeping it for compatibility.
+ (if (file-like? (greeter-configuration-field config 'lightdm-gtk-greeter))
+ (greeter-configuration-field config 'lightdm-gtk-greeter)
+ (greeter-configuration-field config 'greeter-package))
+ (greeter-configuration-field config 'greeter-package))
+ (greeter-configuration-field config 'assets))))
;;; TODO: Implement directly in (gnu services configuration), perhaps by
;;; making the FIELDS argument optional.
@@ -215,11 +287,19 @@ (define fields (greeter-configuration->greeter-fields config))
(define (greeter-configuration->conf-name config)
"Return the file name of CONFIG, a greeter configuration."
- (format #f "~a.conf" (greeter-configuration->greeter-session config)))
+ (greeter-configuration-field config 'greeter-config-name))
(define (greeter-configuration->file config)
"Serialize CONFIG into a file under the output directory, so that it can be
easily added to XDG_CONF_DIRS."
+ (let* ((type-name (config->type-name config))
+ (func-name (string->symbol
+ (string-append
+ "greeter-configuration->file/" type-name)))
+ (eval-env (greeter-configuration-field config 'local-eval-environment)))
+ (local-eval `(,func-name ,config) eval-env)))
+
+(define (greeter-configuration->file/lightdm-gtk-greeter-configuration config)
(computed-file
(greeter-configuration->conf-name config)
#~(begin
@@ -229,6 +309,14 @@ (define (greeter-configuration->file config)
"[greeter]\n"
#$(serialize-configuration* config))))))))
+(define (greeter-configuration->file/lightdm-greeter-general-configuration config)
+ (computed-file
+ (greeter-configuration->conf-name config)
+ #~(begin
+ (call-with-output-file #$output
+ (lambda (port)
+ (format port #$(serialize-configuration* config)))))))
+
;;;
;;; Seats.
@@ -248,15 +336,14 @@ (define (serialize-seat-type name value)
(define-maybe seat-type)
(define (greeter-session? value)
- (memq value '(lightdm-gtk-greeter)))
+ (and (symbol? value)
+ (string-contains (symbol->string value) "-greeter" )))
(define (serialize-greeter-session name value)
(format #f "~a=~a~%" name value))
(define-maybe greeter-session)
-(define-maybe string)
-
;;; Note: all the fields except for the seat name should be 'maybe's, since
;;; the real default value is set by the %lightdm-seat-default define later,
;;; and this avoids repeating ourselves in the serialized configuration file.
@@ -291,22 +378,6 @@ (define-configuration lightdm-seat-configuration
(list-of-strings '())
"Extra configuration values to append to the seat configuration section."))
-(define (greeter-session->greater-configuration-pred identifier)
- "Return the predicate to check if a configuration is of the type specifying
-a greeter identified by IDENTIFIER."
- (match identifier
- ;; Note: register any new greeter identifier here.
- ('lightdm-gtk-greeter
- lightdm-gtk-greeter-configuration?)))
-
-(define (greeter-configuration->greeter-session config)
- "Given CONFIG, a greeter configuration object, return its identifier,
-a symbol."
- (let ((suffix "-configuration")
- (greeter-conf-name (config->name config)))
- (string->symbol (string-drop-right (symbol->string greeter-conf-name)
- (string-length suffix)))))
-
(define list-of-seat-configurations?
(list-of lightdm-seat-configuration?))
@@ -316,9 +387,7 @@ (define list-of-seat-configurations?
;;;
(define (greeter-configuration? config)
- (or (lightdm-gtk-greeter-configuration? config)
- ;; Note: register any new greeter configuration here.
- ))
+ ((record-predicate (struct-vtable config)) config))
(define (list-of-greeter-configurations? greeter-configs)
(and ((list-of greeter-configuration?) greeter-configs)
@@ -347,7 +416,12 @@ (define-configuration/no-serialization lightdm-configuration
start script. It can be refined per seat via the @code{xserver-command} of
the @code{<lightdm-seat-configuration>} record, if desired.")
(greeters
- (list-of-greeter-configurations (list (lightdm-gtk-greeter-configuration)))
+ (list-of-greeter-configurations
+ ;; Remove all configurations which has no config-name.
+ (filter (lambda (cfg)
+ (string? (greeter-configuration->conf-name cfg)))
+ (list (lightdm-gtk-greeter-configuration)
+ (lightdm-greeter-general-configuration))))
"The LightDM greeter configurations specifying the greeters to use.")
(seats
(list-of-seat-configurations (list (lightdm-seat-configuration
@@ -417,8 +491,13 @@ (define (validate-lightdm-configuration config)
(missing-greeters
(filter-map
(lambda (id)
- (define pred (greeter-session->greater-configuration-pred id))
- (if (find pred greeter-configurations)
+ (if (find (lambda (greeter-config)
+ (let* ((id (symbol->string id))
+ (name (greeter-configuration-field
+ greeter-config
+ 'greeter-session-name)))
+ (equal? id name)))
+ greeter-configurations)
#f ;happy path
id))
greeter-sessions)))
@@ -676,4 +755,5 @@ (define lightdm-service-type
(define (generate-doc)
(configuration->documentation 'lightdm-configuration)
(configuration->documentation 'lightdm-gtk-greeter-configuration)
+ (configuration->documentation 'lightdm-greeter-general-configuration)
(configuration->documentation 'lightdm-seat-configuration))
--
2.46.0
--
Feng Shu <tumashu@HIDDEN>:guix-patches@HIDDEN.
Full text available.guix-patches@HIDDEN:bug#75048; Package guix-patches.
Full text available.
GNU bug tracking system
Copyright (C) 1999 Darren O. Benham,
1997 nCipher Corporation Ltd,
1994-97 Ian Jackson.