X-Loop: help-debbugs@HIDDEN
Subject: [bug#75048] [PATCH] Add lightdm-greeter-general-configuration and do not hard code config type name everywhere.
Resent-From: Feng Shu <tumashu@HIDDEN>
Original-Sender: "Debbugs-submit" <debbugs-submit-bounces <at> debbugs.gnu.org>
Resent-CC: guix-patches@HIDDEN
Resent-Date: Mon, 23 Dec 2024 13:22:02 +0000
Resent-Message-ID: <handler.75048.B.173496007719547 <at> debbugs.gnu.org>
Resent-Sender: help-debbugs@HIDDEN
X-GNU-PR-Message: report 75048
X-GNU-PR-Package: guix-patches
X-GNU-PR-Keywords: patch
To: 75048 <at> debbugs.gnu.org
X-Debbugs-Original-To: guix-patches@HIDDEN
Received: via spool by submit <at> debbugs.gnu.org id=B.173496007719547
(code B ref -1); Mon, 23 Dec 2024 13:22:02 +0000
Received: (at submit) by debbugs.gnu.org; 23 Dec 2024 13:21:17 +0000
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>
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-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
--
Content-Disposition: inline Content-Transfer-Encoding: quoted-printable MIME-Version: 1.0 X-Mailer: MIME-tools 5.505 (Entity 5.505) Content-Type: text/plain; charset=utf-8 X-Loop: help-debbugs@HIDDEN From: help-debbugs@HIDDEN (GNU bug Tracking System) To: Feng Shu <tumashu@HIDDEN> Subject: bug#75048: Acknowledgement ([PATCH] Add lightdm-greeter-general-configuration and do not hard code config type name everywhere.) Message-ID: <handler.75048.B.173496007719547.ack <at> debbugs.gnu.org> References: <87pllibkr3.fsf@HIDDEN> X-Gnu-PR-Message: ack 75048 X-Gnu-PR-Package: guix-patches X-Gnu-PR-Keywords: patch Reply-To: 75048 <at> debbugs.gnu.org Date: Mon, 23 Dec 2024 13:22:03 +0000 Thank you for filing a new bug report with debbugs.gnu.org. This is an automatically generated reply to let you know your message has been received. Your message is being forwarded to the package maintainers and other interested parties for their attention; they will reply in due course. Your message has been sent to the package maintainer(s): guix-patches@HIDDEN If you wish to submit further information on this problem, please send it to 75048 <at> debbugs.gnu.org. Please do not send mail to help-debbugs@HIDDEN unless you wish to report a problem with the Bug-tracking system. --=20 75048: https://debbugs.gnu.org/cgi/bugreport.cgi?bug=3D75048 GNU Bug Tracking System Contact help-debbugs@HIDDEN with problems
X-Loop: help-debbugs@HIDDEN
Subject: [bug#75048] [PATCH v2] Add lightdm-greeter-general-configuration and do not hard code config type name everywhere.
References: <87pllibkr3.fsf@HIDDEN>
In-Reply-To: <87pllibkr3.fsf@HIDDEN>
Resent-From: Feng Shu <tumashu@HIDDEN>
Original-Sender: "Debbugs-submit" <debbugs-submit-bounces <at> debbugs.gnu.org>
Resent-CC: guix-patches@HIDDEN
Resent-Date: Tue, 24 Dec 2024 01:09:01 +0000
Resent-Message-ID: <handler.75048.B75048.173500253325015 <at> debbugs.gnu.org>
Resent-Sender: help-debbugs@HIDDEN
X-GNU-PR-Message: followup 75048
X-GNU-PR-Package: guix-patches
X-GNU-PR-Keywords: patch
To: 75048 <at> debbugs.gnu.org
Received: via spool by 75048-submit <at> debbugs.gnu.org id=B75048.173500253325015
(code B ref 75048); Tue, 24 Dec 2024 01:09:01 +0000
Received: (at 75048) by debbugs.gnu.org; 24 Dec 2024 01:08:53 +0000
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>
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-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
--
X-Loop: help-debbugs@HIDDEN
Subject: [bug#75048] [PATCH v3] Add lightdm-greeter-general-configuration and do not hard code config type name everywhere.
References: <87pllibkr3.fsf@HIDDEN>
In-Reply-To: <87pllibkr3.fsf@HIDDEN>
Resent-From: Feng Shu <tumashu@HIDDEN>
Original-Sender: "Debbugs-submit" <debbugs-submit-bounces <at> debbugs.gnu.org>
Resent-CC: guix-patches@HIDDEN
Resent-Date: Tue, 24 Dec 2024 07:34:01 +0000
Resent-Message-ID: <handler.75048.B75048.173502561529495 <at> debbugs.gnu.org>
Resent-Sender: help-debbugs@HIDDEN
X-GNU-PR-Message: followup 75048
X-GNU-PR-Package: guix-patches
X-GNU-PR-Keywords: patch
To: 75048 <at> debbugs.gnu.org
Received: via spool by 75048-submit <at> debbugs.gnu.org id=B75048.173502561529495
(code B ref 75048); Tue, 24 Dec 2024 07:34:01 +0000
Received: (at 75048) by debbugs.gnu.org; 24 Dec 2024 07:33:35 +0000
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>
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-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
--
X-Loop: help-debbugs@HIDDEN
Subject: [bug#75048] [PATCH v4] Add lightdm-greeter-general-configuration and do not hard code config type name everywhere.
References: <87pllibkr3.fsf@HIDDEN>
In-Reply-To: <87pllibkr3.fsf@HIDDEN>
Resent-From: tumashu@HIDDEN
Original-Sender: "Debbugs-submit" <debbugs-submit-bounces <at> debbugs.gnu.org>
Resent-CC: tumashu@HIDDEN, guix-patches@HIDDEN
Resent-Date: Wed, 25 Dec 2024 03:09:02 +0000
Resent-Message-ID: <handler.75048.B75048.173509611030006 <at> debbugs.gnu.org>
Resent-Sender: help-debbugs@HIDDEN
X-GNU-PR-Message: followup 75048
X-GNU-PR-Package: guix-patches
X-GNU-PR-Keywords: patch
To: 75048 <at> debbugs.gnu.org
Cc: Feng Shu <tumashu@HIDDEN>, Feng Shu <tumashu@HIDDEN>
X-Debbugs-Original-Xcc: Feng Shu <tumashu@HIDDEN>
Received: via spool by 75048-submit <at> debbugs.gnu.org id=B75048.173509611030006
(code B ref 75048); Wed, 25 Dec 2024 03:09:02 +0000
Received: (at 75048) by debbugs.gnu.org; 25 Dec 2024 03:08:30 +0000
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
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
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-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
X-Loop: help-debbugs@HIDDEN
Subject: [bug#75048] [PATCH v5] Add lightdm-greeter-general-configuration and do not hard code config type name everywhere.
References: <87pllibkr3.fsf@HIDDEN>
In-Reply-To: <87pllibkr3.fsf@HIDDEN>
Resent-From: tumashu@HIDDEN
Original-Sender: "Debbugs-submit" <debbugs-submit-bounces <at> debbugs.gnu.org>
Resent-CC: tumashu@HIDDEN, tumashu@HIDDEN, guix-patches@HIDDEN
Resent-Date: Wed, 25 Dec 2024 06:04:01 +0000
Resent-Message-ID: <handler.75048.B75048.173510662630289 <at> debbugs.gnu.org>
Resent-Sender: help-debbugs@HIDDEN
X-GNU-PR-Message: followup 75048
X-GNU-PR-Package: guix-patches
X-GNU-PR-Keywords: patch
To: 75048 <at> debbugs.gnu.org
Cc: Feng Shu <tumashu@HIDDEN>, Feng Shu <tumashu@HIDDEN>, tumashu@HIDDEN
X-Debbugs-Original-Xcc: Feng Shu <tumashu@HIDDEN>, tumashu@HIDDEN
Received: via spool by 75048-submit <at> debbugs.gnu.org id=B75048.173510662630289
(code B ref 75048); Wed, 25 Dec 2024 06:04:01 +0000
Received: (at 75048) by debbugs.gnu.org; 25 Dec 2024 06:03:46 +0000
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
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
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-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
X-Loop: help-debbugs@HIDDEN
Subject: [bug#75048] [PATCH v6] Add lightdm-greeter-general-configuration and do not hard code config type name everywhere.
References: <87pllibkr3.fsf@HIDDEN>
In-Reply-To: <87pllibkr3.fsf@HIDDEN>
Resent-From: tumashu@HIDDEN
Original-Sender: "Debbugs-submit" <debbugs-submit-bounces <at> debbugs.gnu.org>
Resent-CC: tumashu@HIDDEN, tumashu@HIDDEN, guix-patches@HIDDEN
Resent-Date: Mon, 30 Dec 2024 00:35:01 +0000
Resent-Message-ID: <handler.75048.B75048.173551888624408 <at> debbugs.gnu.org>
Resent-Sender: help-debbugs@HIDDEN
X-GNU-PR-Message: followup 75048
X-GNU-PR-Package: guix-patches
X-GNU-PR-Keywords: patch
To: 75048 <at> debbugs.gnu.org
Cc: Feng Shu <tumashu@HIDDEN>, Feng Shu <tumashu@HIDDEN>, tumashu@HIDDEN
X-Debbugs-Original-Xcc: Feng Shu <tumashu@HIDDEN>, tumashu@HIDDEN
Received: via spool by 75048-submit <at> debbugs.gnu.org id=B75048.173551888624408
(code B ref 75048); Mon, 30 Dec 2024 00:35:01 +0000
Received: (at 75048) by debbugs.gnu.org; 30 Dec 2024 00:34:46 +0000
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
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
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-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
X-Loop: help-debbugs@HIDDEN
Subject: [bug#75048] Please review this patch.
References: <87pllibkr3.fsf@HIDDEN>
In-Reply-To: <87pllibkr3.fsf@HIDDEN>
Resent-From: Feng Shu <tumashu@HIDDEN>
Original-Sender: "Debbugs-submit" <debbugs-submit-bounces <at> debbugs.gnu.org>
Resent-CC: guix-patches@HIDDEN
Resent-Date: Mon, 30 Dec 2024 01:47:03 +0000
Resent-Message-ID: <handler.75048.B75048.17355232004211 <at> debbugs.gnu.org>
Resent-Sender: help-debbugs@HIDDEN
X-GNU-PR-Message: followup 75048
X-GNU-PR-Package: guix-patches
X-GNU-PR-Keywords: patch
To: 75043 <at> debbugs.gnu.org, 75044 <at> debbugs.gnu.org, 75048 <at> debbugs.gnu.org
Received: via spool by 75048-submit <at> debbugs.gnu.org id=B75048.17355232004211
(code B ref 75048); Mon, 30 Dec 2024 01:47:03 +0000
Received: (at 75048) by debbugs.gnu.org; 30 Dec 2024 01:46:40 +0000
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>
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-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.
--
X-Loop: help-debbugs@HIDDEN
Subject: [bug#75048] [PATCH v7] Add lightdm-greeter-general-configuration and do not hard code config type name everywhere.
References: <87pllibkr3.fsf@HIDDEN>
In-Reply-To: <87pllibkr3.fsf@HIDDEN>
Resent-From: tumashu@HIDDEN
Original-Sender: "Debbugs-submit" <debbugs-submit-bounces <at> debbugs.gnu.org>
Resent-CC: tumashu@HIDDEN, tumashu@HIDDEN, guix-patches@HIDDEN
Resent-Date: Fri, 03 Jan 2025 02:29:02 +0000
Resent-Message-ID: <handler.75048.B75048.173587129531433 <at> debbugs.gnu.org>
Resent-Sender: help-debbugs@HIDDEN
X-GNU-PR-Message: followup 75048
X-GNU-PR-Package: guix-patches
X-GNU-PR-Keywords: patch
To: 75048 <at> debbugs.gnu.org
Cc: Feng Shu <tumashu@HIDDEN>, Feng Shu <tumashu@HIDDEN>, tumashu@HIDDEN
X-Debbugs-Original-Xcc: Feng Shu <tumashu@HIDDEN>, tumashu@HIDDEN
Received: via spool by 75048-submit <at> debbugs.gnu.org id=B75048.173587129531433
(code B ref 75048); Fri, 03 Jan 2025 02:29:02 +0000
Received: (at 75048) by debbugs.gnu.org; 3 Jan 2025 02:28:15 +0000
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
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
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-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
X-Loop: help-debbugs@HIDDEN
Subject: [bug#75048] [PATCH] Add lightdm-greeter-general-configuration and do not hard code config type name everywhere.
References: <87pllibkr3.fsf@HIDDEN>
In-Reply-To: <87pllibkr3.fsf@HIDDEN>
Resent-From: Feng Shu <tumashu@HIDDEN>
Original-Sender: "Debbugs-submit" <debbugs-submit-bounces <at> debbugs.gnu.org>
Resent-CC: guix-patches@HIDDEN
Resent-Date: Fri, 03 Jan 2025 02:32:02 +0000
Resent-Message-ID: <handler.75048.B75048.173587149732302 <at> debbugs.gnu.org>
Resent-Sender: help-debbugs@HIDDEN
X-GNU-PR-Message: followup 75048
X-GNU-PR-Package: guix-patches
X-GNU-PR-Keywords: patch
To: 75048 <at> debbugs.gnu.org
Received: via spool by 75048-submit <at> debbugs.gnu.org id=B75048.173587149732302
(code B ref 75048); Fri, 03 Jan 2025 02:32:02 +0000
Received: (at 75048) by debbugs.gnu.org; 3 Jan 2025 02:31:37 +0000
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>
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-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.
--
GNU bug tracking system
Copyright (C) 1999 Darren O. Benham,
1997 nCipher Corporation Ltd,
1994-97 Ian Jackson.