Package: guix-patches;
Reported by: Feng Shu <tumashu <at> 163.com>
Date: Mon, 23 Dec 2024 13:22:02 UTC
Severity: normal
Tags: patch
To reply to this bug, email your comments to 75048 AT debbugs.gnu.org.
Toggle the display of automated, internal messages from the tracker.
View this report as an mbox folder, status mbox, maintainer mbox
guix-patches <at> gnu.org:bug#75048; Package guix-patches.
(Mon, 23 Dec 2024 13:22:02 GMT) Full text and rfc822 format available.Feng Shu <tumashu <at> 163.com>:guix-patches <at> gnu.org.
(Mon, 23 Dec 2024 13:22:02 GMT) Full text and rfc822 format available.Message #5 received at submit <at> debbugs.gnu.org (full text, mbox):
From: Feng Shu <tumashu <at> 163.com> To: guix-patches <at> gnu.org Subject: [PATCH] Add lightdm-greeter-general-configuration and do not hard code config type name everywhere. Date: Mon, 23 Dec 2024 21:18:40 +0800
From 0a49889ee8ceda8c311a12c9f1e1f44cecb3e100 Mon Sep 17 00:00:00 2001
From: Feng Shu <tumashu <at> 163.com>
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
--
guix-patches <at> gnu.org:bug#75048; Package guix-patches.
(Tue, 24 Dec 2024 01:09:01 GMT) Full text and rfc822 format available.Message #8 received at 75048 <at> debbugs.gnu.org (full text, mbox):
From: Feng Shu <tumashu <at> 163.com> To: 75048 <at> debbugs.gnu.org Subject: [PATCH v2] Add lightdm-greeter-general-configuration and do not hard code config type name everywhere. Date: Tue, 24 Dec 2024 09:08:38 +0800
From 4bfdb9f1db0c0c23d57c68691f0fe36d6e3823f4 Mon Sep 17 00:00:00 2001
From: Feng Shu <tumashu <at> 163.com>
Date: Mon, 23 Dec 2024 19:30:28 +0800
Subject: [PATCH v2] Add lightdm-greeter-general-configuration and do not hard
code config type name everywhere.
* gnu/services/lightdm.scm (gnu): Use (ice-9 local-eval), export new option variables.
(local-eval-environment?): New variable.
(string): Move.
(lightdm-gtk-greeter-configuration): Add local-eval-environment,
greeter-session-name, greeter-package, greeter-config-name fields.
(lightdm-greeter-general-configuration): New variable.
(strip-record-type-name-brackets): Return string instead symbol.
(config->type-name): Rename from config->name.
(greeter-configuration-field): New function.
(greeter-configuration->greeter-fields): Do not hard code greeter configuation name.
(greeter-configuration->packages): Do not hard code greeter configuation name.
(greeter-configuration->conf-name): Improve.
(greeter-configuration->session-name): New variable.
(greeter-configuration->file): Call different function based config type.
(greeter-configuration->file/lightdm-gtk-greeter-configuration)
(greeter-configuration->file/lightdm-greeter-general-configuration): New functions.
(greeter-configuration-valid?): New function.
(greeter-session?): Do not hard code greeter configuation name.
(greeter-session->greater-configuration-pred)
(greeter-configuration->greeter-session): Removed.
(greeter-configuration?): Do not hard code greeter configuation name.
(lightdm-configuration): Add lightdm-greeter-general-configuration.
(validate-lightdm-configuration): Do not use greeter-session->greater-configuration-pred.
(generate-doc): Handle lightdm-greeter-general-configuration.
* doc/guix.texi (X Window): Improve lightdm-gtk-greeter-configuration options
doc, Add lightdm-greeter-general-configuration,
Change-Id: Iae22cd641454c86280e88d6986594ad0c8f4c490
---
doc/guix.texi | 94 ++++++++++++++++-
gnu/services/lightdm.scm | 221 +++++++++++++++++++++++++++------------
2 files changed, 246 insertions(+), 69 deletions(-)
diff --git a/doc/guix.texi b/doc/guix.texi
index 31deb5b003..e1f1fee68b 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -23802,8 +23802,7 @@ In its most basic form, it can be used simply as:
(service lightdm-service-type)
@end lisp
-A more elaborate example making use of the VNC capabilities and enabling
-more features and verbose logs could look like:
+Two more elaborate examples look like below:
@lisp
(service lightdm-service-type
@@ -23819,6 +23818,38 @@ more features and verbose logs could look like:
(name "*")
(user-session "ratpoison"))))))
@end lisp
+
+@lisp
+(service lightdm-service-type
+ (lightdm-configuration
+ (greeters
+ (list (lightdm-greeter-general-configuration
+ (greeter-package lightdm-mini-greeter)
+ (greeter-session-name "lightdm-mini-greeter")
+ (greeter-config-name "lightdm-mini-greeter.conf")
+ (config (list "[greeter]"
+ "user = guest")))
+ (lightdm-gtk-greeter-configuration
+ (extra-config
+ (list "font-name = San 10"
+ "xft-dpi = 140"
+ "clock-format = %Y-%m-%d %H:%M"
+ ;; We need to use "~~" to generate a tilde, for
+ ;; extra-config sting will be handle as
+ ;; control-string of format function.
+ "indicators = ~~host;~~spacer;~~session;~~a11y;~~clock;~~power")))))
+ (seats
+ (list (lightdm-seat-configuration
+ (name "*")
+ (greeter-session 'lightdm-mini-greeter))))
+ (xorg-configuration
+ (xorg-configuration
+ (server-arguments
+ (append %default-xorg-server-arguments
+ '("-dpi" "140")))))))
+@end lisp
+
+
@end defvar
@c The LightDM service documentation can be auto-generated via the
@@ -23903,8 +23934,21 @@ Extra configuration values to append to the LightDM configuration file.
Available @code{lightdm-gtk-greeter-configuration} fields are:
@table @asis
+@item @code{local-eval-environment} (default: @code{(the-environment)}) (type: local-eval-environment)
+Recode the environment where lightdm-gtk-greeter-configuration is defined.
+
@item @code{lightdm-gtk-greeter} (default: @code{lightdm-gtk-greeter}) (type: file-like)
-The lightdm-gtk-greeter package to use.
+The lightdm-gtk-greeter package to use, this option is keeped for
+compatibility, use greeter-package instead.
+
+@item @code{greeter-package} (default: @code{lightdm-gtk-greeter}) (type: file-like)
+The greeter package to use.
+
+@item @code{greeter-session-name} (default: @code{lightdm-gtk-greeter}) (type: string)
+The session name used in lightdm.conf.
+
+@item @code{greeter-config-name} (default: @code{lightdm-gtk-greeter.conf}) (type: string)
+The greeter config file name in /etc/lightdm directory.
@item @code{assets} (default: @code{(adwaita-icon-theme gnome-themes-extra hicolor-icon-theme)}) (type: list-of-file-likes)
The list of packages complementing the greeter, such as package
@@ -23948,6 +23992,50 @@ configuration file.
@c %end of fragment
@c %start of fragment
+@deftp {Data Type} lightdm-greeter-general-configuration
+
+@code{lightdm-greeter-general-configuration} support all text config
+greeters which have no build-in configuration type like
+@code{lightdm-gtk-greeter-configuration}, such as lightdm-mini-greeter,
+for example:
+
+@lisp
+(lightdm-greeter-general-configuration
+ (greeter-package lightdm-mini-greeter)
+ (greeter-session-name "lightdm-mini-greeter")
+ (greeter-config-name "lightdm-mini-greeter.conf")
+ (config (list "[greeter]"
+ "user = guest")))
+@end lisp
+
+Available @code{lightdm-greeter-general-configuration} fields are:
+
+@table @asis
+@item @code{local-eval-environment} (default: @code{(the-environment)}) (type: local-eval-environment)
+Recode the environment where lightdm-greeter-general-configuration is defined.
+
+@item @code{greeter-package} (type: maybe-file-like)
+The greeter package to use.
+
+@item @code{greeter-session-name} (type: maybe-string)
+The session name used in lightdm.conf.
+
+@item @code{greeter-config-name} (type: maybe-string)
+The greeter config file name in /etc/lightdm directory.
+
+@item @code{assets} (default: @code{(adwaita-icon-theme gnome-themes-extra hicolor-icon-theme)}) (type: list-of-file-likes)
+The list of packages complementing the greeter, such as package
+providing icon themes.
+
+@item @code{config} (default: @code{'()}) (type: list-of-strings)
+Configuration values of the LightDM Greeter configuration file.
+
+@end table
+@end deftp
+
+@c %end of fragment
+@c %start of fragment
+
@deftp {Data Type} lightdm-seat-configuration
Available @code{lightdm-seat-configuration} fields are:
diff --git a/gnu/services/lightdm.scm b/gnu/services/lightdm.scm
index 191cb5635b..035ea41c70 100644
--- a/gnu/services/lightdm.scm
+++ b/gnu/services/lightdm.scm
@@ -39,6 +39,7 @@ (define-module (gnu services lightdm)
#:use-module (guix i18n)
#:use-module (guix records)
#:use-module (ice-9 format)
+ #:use-module (ice-9 local-eval)
#:use-module (ice-9 match)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-26)
@@ -56,7 +57,10 @@ (define-module (gnu services lightdm)
lightdm-gtk-greeter-configuration
lightdm-gtk-greeter-configuration?
lightdm-gtk-greeter-configuration-lightdm-gtk-greeter
+ lightdm-gtk-greeter-configuration-greeter-package
lightdm-gtk-greeter-configuration-assets
+ lightdm-gtk-greeter-configuration-greeter-config-name
+ lightdm-gtk-greeter-configuration-greeter-session-name
lightdm-gtk-greeter-configuration-theme-name
lightdm-gtk-greeter-configuration-icon-theme-name
lightdm-gtk-greeter-configuration-cursor-theme-name
@@ -66,6 +70,14 @@ (define-module (gnu services lightdm)
lightdm-gtk-greeter-configuration-reader
lightdm-gtk-greeter-configuration-extra-config
+ lightdm-greeter-general-configuration
+ lightdm-greeter-general-configuration?
+ lightdm-greeter-general-configuration-greeter-package
+ lightdm-greeter-general-configuration-assets
+ lightdm-greeter-general-configuration-greeter-config-name
+ lightdm-greeter-general-configuration-greeter-session-name
+ lightdm-greeter-general-configuration-config
+
lightdm-configuration
lightdm-configuration?
lightdm-configuration-lightdm
@@ -87,6 +99,9 @@ (define-module (gnu services lightdm)
;;; Greeters.
;;;
+(define (local-eval-environment? value)
+ #t)
+
(define list-of-file-likes?
(list-of file-like?))
@@ -117,6 +132,8 @@ (define (serialize-file-like name value)
(define (serialize-list-of-a11y-states name value)
(format #f "~a=~a~%" name (string-join (map symbol->string value) ";")))
+(define-maybe string)
+
(define (serialize-string name value)
(format #f "~a=~a~%" name value))
@@ -127,9 +144,21 @@ (define (serialize-list-of-strings _ value)
(string-join value "\n"))
(define-configuration lightdm-gtk-greeter-configuration
+ (local-eval-environment
+ (local-eval-environment (the-environment))
+ "Recode the environment where lightdm-gtk-greeter-configuration is defined."
+ empty-serializer)
+ (greeter-session-name
+ (string "lightdm-gtk-greeter")
+ "Session name used in lightdm.conf"
+ empty-serializer)
(lightdm-gtk-greeter
+ maybe-file-like
+ "Keep it for compatibility, use greeter-package field instead."
+ empty-serializer)
+ (greeter-package
(file-like lightdm-gtk-greeter)
- "The lightdm-gtk-greeter package to use."
+ "The greeter package to use."
empty-serializer)
(assets
(list-of-file-likes (list adwaita-icon-theme
@@ -140,6 +169,10 @@ (define-configuration lightdm-gtk-greeter-configuration
"The list of packages complementing the greeter, such as package providing
icon themes."
empty-serializer)
+ (greeter-config-name
+ (string "lightdm-gtk-greeter.conf")
+ "Greeter config file name in /etc/lightdm directory."
+ empty-serializer)
(theme-name
(string "Adwaita")
"The name of the theme to use.")
@@ -176,34 +209,77 @@ (define-configuration lightdm-gtk-greeter-configuration
"Extra configuration values to append to the LightDM GTK Greeter
configuration file."))
+(define-configuration lightdm-greeter-general-configuration
+ (local-eval-environment
+ (local-eval-environment (the-environment))
+ "Recode the environment where lightdm-greeter-general-configuration is defined."
+ empty-serializer)
+ (greeter-package
+ maybe-file-like
+ "The greeter package to use."
+ empty-serializer)
+ (assets
+ (list-of-file-likes (list adwaita-icon-theme
+ gnome-themes-extra
+ ;; FIXME: hicolor-icon-theme should be in the
+ ;; packages of the desktop templates.
+ hicolor-icon-theme))
+ "The list of packages complementing the greeter, such as package providing
+icon themes."
+ empty-serializer)
+ (greeter-config-name
+ maybe-string
+ "Greeter config file name in /etc/lightdm directory."
+ empty-serializer)
+ (greeter-session-name
+ maybe-string
+ "Session name used in lightdm.conf"
+ empty-serializer)
+ (config
+ (list-of-strings '())
+ "Configuration values of the LightDM Greeter configuration file."))
+
(define (strip-record-type-name-brackets name)
"Remove the '<' and '>' brackets from NAME, a symbol."
(let ((name (symbol->string name)))
(if (and (string-prefix? "<" name)
(string-suffix? ">" name))
- (string->symbol (string-drop (string-drop-right name 1) 1))
+ (string-drop (string-drop-right name 1) 1)
(error "unexpected record type name" name))))
-(define (config->name config)
- "Return the constructor name (a symbol) from CONFIG."
+(define (config->type-name config)
+ "Return the type name of CONFIG."
(strip-record-type-name-brackets
(record-type-name (struct-vtable config))))
+(define (greeter-configuration-field config field)
+ "Return field value of config."
+ (let ((rtd (struct-vtable config)))
+ ((record-accessor rtd field) config)))
+
+(define (greeter-configuration->session-name config)
+ "Return the session name of CONFIG, a greeter configuration."
+ (greeter-configuration-field config 'greeter-session-name))
+
(define (greeter-configuration->greeter-fields config)
"Return the fields of CONFIG, a greeter configuration."
- (match config
- ;; Note: register any new greeter configuration here.
- ((? lightdm-gtk-greeter-configuration?)
- lightdm-gtk-greeter-configuration-fields)))
+ (let* ((type-name (config->type-name config))
+ (variable (string->symbol (string-append type-name "-fields")))
+ (eval-env (greeter-configuration-field config 'local-eval-environment)))
+ (local-eval variable eval-env)))
(define (greeter-configuration->packages config)
"Return the list of greeter packages, including assets, used by CONFIG, a
greeter configuration."
- (match config
- ;; Note: register any new greeter configuration here.
- ((? lightdm-gtk-greeter-configuration?)
- (cons (lightdm-gtk-greeter-configuration-lightdm-gtk-greeter config)
- (lightdm-gtk-greeter-configuration-assets config)))))
+ (filter file-like?
+ (cons
+ (if (eq? (config->type-name config) 'lightdm-gtk-greeter-configuration)
+ ;; Handle lightdm-gtk-greeter field for keeping it for compatibility.
+ (if (file-like? (greeter-configuration-field config 'lightdm-gtk-greeter))
+ (greeter-configuration-field config 'lightdm-gtk-greeter)
+ (greeter-configuration-field config 'greeter-package))
+ (greeter-configuration-field config 'greeter-package))
+ (greeter-configuration-field config 'assets))))
;;; TODO: Implement directly in (gnu services configuration), perhaps by
;;; making the FIELDS argument optional.
@@ -215,11 +291,19 @@ (define fields (greeter-configuration->greeter-fields config))
(define (greeter-configuration->conf-name config)
"Return the file name of CONFIG, a greeter configuration."
- (format #f "~a.conf" (greeter-configuration->greeter-session config)))
+ (greeter-configuration-field config 'greeter-config-name))
(define (greeter-configuration->file config)
"Serialize CONFIG into a file under the output directory, so that it can be
easily added to XDG_CONF_DIRS."
+ (let* ((type-name (config->type-name config))
+ (func-name (string->symbol
+ (string-append
+ "greeter-configuration->file/" type-name)))
+ (eval-env (greeter-configuration-field config 'local-eval-environment)))
+ (local-eval `(,func-name ,config) eval-env)))
+
+(define (greeter-configuration->file/lightdm-gtk-greeter-configuration config)
(computed-file
(greeter-configuration->conf-name config)
#~(begin
@@ -229,6 +313,23 @@ (define (greeter-configuration->file config)
"[greeter]\n"
#$(serialize-configuration* config))))))))
+(define (greeter-configuration->file/lightdm-greeter-general-configuration config)
+ (computed-file
+ (greeter-configuration->conf-name config)
+ #~(begin
+ (call-with-output-file #$output
+ (lambda (port)
+ (format port #$(serialize-configuration* config)))))))
+
+(define (greeter-configuration-valid? config)
+ "Check greeter-configuration CONFIG valid or not."
+ (let ((conf-name (greeter-configuration->conf-name config))
+ (session-name (greeter-configuration->session-name config)))
+ (and (string? conf-name)
+ (string? session-name)
+ (> (string-length conf-name) 0)
+ (> (string-length session-name) 0))))
+
;;;
;;; Seats.
@@ -248,15 +349,14 @@ (define (serialize-seat-type name value)
(define-maybe seat-type)
(define (greeter-session? value)
- (memq value '(lightdm-gtk-greeter)))
+ (and (symbol? value)
+ (string-contains (symbol->string value) "-greeter" )))
(define (serialize-greeter-session name value)
(format #f "~a=~a~%" name value))
(define-maybe greeter-session)
-(define-maybe string)
-
;;; Note: all the fields except for the seat name should be 'maybe's, since
;;; the real default value is set by the %lightdm-seat-default define later,
;;; and this avoids repeating ourselves in the serialized configuration file.
@@ -291,22 +391,6 @@ (define-configuration lightdm-seat-configuration
(list-of-strings '())
"Extra configuration values to append to the seat configuration section."))
-(define (greeter-session->greater-configuration-pred identifier)
- "Return the predicate to check if a configuration is of the type specifying
-a greeter identified by IDENTIFIER."
- (match identifier
- ;; Note: register any new greeter identifier here.
- ('lightdm-gtk-greeter
- lightdm-gtk-greeter-configuration?)))
-
-(define (greeter-configuration->greeter-session config)
- "Given CONFIG, a greeter configuration object, return its identifier,
-a symbol."
- (let ((suffix "-configuration")
- (greeter-conf-name (config->name config)))
- (string->symbol (string-drop-right (symbol->string greeter-conf-name)
- (string-length suffix)))))
-
(define list-of-seat-configurations?
(list-of lightdm-seat-configuration?))
@@ -316,20 +400,17 @@ (define list-of-seat-configurations?
;;;
(define (greeter-configuration? config)
- (or (lightdm-gtk-greeter-configuration? config)
- ;; Note: register any new greeter configuration here.
- ))
+ ((record-predicate (struct-vtable config)) config))
(define (list-of-greeter-configurations? greeter-configs)
(and ((list-of greeter-configuration?) greeter-configs)
;; Greeter configurations must also not be provided more than once.
- (let* ((types (map (compose record-type-name struct-vtable)
- greeter-configs))
- (dupes (filter (lambda (type)
- (< 1 (count (cut eq? type <>) types)))
- types)))
+ (let* ((conf-names (map greeter-configuration->conf-name greeter-configs))
+ (dupes (filter (lambda (conf-name)
+ (< 1 (count (cut eq? conf-name <>) conf-names)))
+ conf-names)))
(unless (null? dupes)
- (leave (G_ "duplicate greeter configurations: ~a~%") dupes)))))
+ (leave (G_ "Duplicate greeter configurations: ~a~%") dupes)))))
(define-configuration/no-serialization lightdm-configuration
(lightdm
@@ -347,7 +428,9 @@ (define-configuration/no-serialization lightdm-configuration
start script. It can be refined per seat via the @code{xserver-command} of
the @code{<lightdm-seat-configuration>} record, if desired.")
(greeters
- (list-of-greeter-configurations (list (lightdm-gtk-greeter-configuration)))
+ (list-of-greeter-configurations
+ (list (lightdm-gtk-greeter-configuration)
+ (lightdm-greeter-general-configuration)))
"The LightDM greeter configurations specifying the greeters to use.")
(seats
(list-of-seat-configurations (list (lightdm-seat-configuration
@@ -417,8 +500,11 @@ (define (validate-lightdm-configuration config)
(missing-greeters
(filter-map
(lambda (id)
- (define pred (greeter-session->greater-configuration-pred id))
- (if (find pred greeter-configurations)
+ (if (find (lambda (greeter-config)
+ (let* ((id (symbol->string id))
+ (name (greeter-configuration->session-name greeter-config)))
+ (equal? id name)))
+ greeter-configurations)
#f ;happy path
id))
greeter-sessions)))
@@ -428,10 +514,11 @@ (define pred (greeter-session->greater-configuration-pred id))
(define (lightdm-configuration-file config)
(match-record config <lightdm-configuration>
- (xorg-configuration seats
- xdmcp? xdmcp-listen-address
- vnc-server? vnc-server-command vnc-server-listen-address vnc-server-port
- extra-config)
+ (xorg-configuration
+ seats xdmcp? xdmcp-listen-address
+ vnc-server? vnc-server-command
+ vnc-server-listen-address vnc-server-port
+ extra-config)
(apply
mixed-text-file
"lightdm.conf" "
@@ -470,22 +557,22 @@ (define (lightdm-configuration-file config)
# Seat configuration.
#
"
- (map (lambda (seat)
- ;; This complication exists to propagate a default value for
- ;; the 'xserver-command' field of the seats. Having a
- ;; 'xorg-configuration' field at the root of the
- ;; lightdm-configuration enables the use of
- ;; 'set-xorg-configuration' and can be more convenient.
- (let ((seat* (if (maybe-value-set?
- (lightdm-seat-configuration-xserver-command seat))
- seat
- (lightdm-seat-configuration
- (inherit seat)
- (xserver-command (xorg-start-command
- xorg-configuration))))))
- (serialize-configuration seat*
- lightdm-seat-configuration-fields)))
- seats))))
+ (map (lambda (seat)
+ ;; This complication exists to propagate a default value for
+ ;; the 'xserver-command' field of the seats. Having a
+ ;; 'xorg-configuration' field at the root of the
+ ;; lightdm-configuration enables the use of
+ ;; 'set-xorg-configuration' and can be more convenient.
+ (let ((seat* (if (maybe-value-set?
+ (lightdm-seat-configuration-xserver-command seat))
+ seat
+ (lightdm-seat-configuration
+ (inherit seat)
+ (xserver-command (xorg-start-command
+ xorg-configuration))))))
+ (serialize-configuration seat*
+ lightdm-seat-configuration-fields)))
+ seats))))
(define (lightdm-configuration-directory config)
"Return a directory containing the serialized lightdm configuration
@@ -495,7 +582,8 @@ (define (lightdm-configuration-directory config)
(map (lambda (g)
`(,(greeter-configuration->conf-name g)
,(greeter-configuration->file g)))
- (lightdm-configuration-greeters config)))))
+ (filter greeter-configuration-valid?
+ (lightdm-configuration-greeters config))))))
(define %lightdm-accounts
(list (user-group (name "lightdm") (system? #t))
@@ -676,4 +764,5 @@ (define lightdm-service-type
(define (generate-doc)
(configuration->documentation 'lightdm-configuration)
(configuration->documentation 'lightdm-gtk-greeter-configuration)
+ (configuration->documentation 'lightdm-greeter-general-configuration)
(configuration->documentation 'lightdm-seat-configuration))
--
2.45.2
--
guix-patches <at> gnu.org:bug#75048; Package guix-patches.
(Tue, 24 Dec 2024 07:34:01 GMT) Full text and rfc822 format available.Message #11 received at 75048 <at> debbugs.gnu.org (full text, mbox):
From: Feng Shu <tumashu <at> 163.com> To: 75048 <at> debbugs.gnu.org Subject: [PATCH v3] Add lightdm-greeter-general-configuration and do not hard code config type name everywhere. Date: Tue, 24 Dec 2024 15:33:20 +0800
From 7fd615c0b03356414919a6ae2799758491b8f582 Mon Sep 17 00:00:00 2001
From: Feng Shu <tumashu <at> 163.com>
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
--
tumashu <at> 163.com, guix-patches <at> gnu.org:bug#75048; Package guix-patches.
(Wed, 25 Dec 2024 03:09:02 GMT) Full text and rfc822 format available.Message #14 received at 75048 <at> debbugs.gnu.org (full text, mbox):
From: tumashu <at> 163.com To: 75048 <at> debbugs.gnu.org Cc: Feng Shu <tumashu <at> 163.com> Subject: [PATCH v4] Add lightdm-greeter-general-configuration and do not hard code config type name everywhere. Date: Wed, 25 Dec 2024 11:08:05 +0800
From: Feng Shu <tumashu <at> 163.com>
* gnu/services/lightdm.scm (gnu): Use (ice-9 local-eval), export new option variables.
(local-eval-environment?): New variable.
(string): Move.
(lightdm-gtk-greeter-configuration): Add local-eval-environment,
greeter-session-name, greeter-package, greeter-config-name fields.
(lightdm-greeter-general-configuration): New variable.
(strip-record-type-name-brackets): Return string instead symbol.
(config->type-name): Rename from config->name.
(greeter-configuration-field): New function.
(greeter-configuration->greeter-fields): Do not hard code greeter configuation name.
(greeter-configuration->packages): Do not hard code greeter configuation name.
(greeter-configuration->conf-name): Improve.
(greeter-configuration->session-name): New variable.
(greeter-configuration->file): Call different function based config type.
(greeter-configuration->file/lightdm-gtk-greeter-configuration)
(greeter-configuration->file/lightdm-greeter-general-configuration): New functions.
(greeter-configuration-valid?): New function.
(greeter-session?): Do not hard code greeter configuation name.
(greeter-session->greater-configuration-pred)
(greeter-configuration->greeter-session): Removed.
(greeter-configuration?): Do not hard code greeter configuation name.
(lightdm-configuration): Add lightdm-greeter-general-configuration.
(validate-lightdm-configuration): Do not use greeter-session->greater-configuration-pred.
(generate-doc): Handle lightdm-greeter-general-configuration.
* doc/guix.texi (X Window): Improve lightdm-gtk-greeter-configuration options
doc, Add lightdm-greeter-general-configuration,
Change-Id: Iae22cd641454c86280e88d6986594ad0c8f4c490
---
doc/guix.texi | 94 +++++++++++++++-
gnu/services/lightdm.scm | 225 +++++++++++++++++++++++++++------------
2 files changed, 250 insertions(+), 69 deletions(-)
diff --git a/doc/guix.texi b/doc/guix.texi
index 31deb5b003..e1f1fee68b 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -23802,8 +23802,7 @@ In its most basic form, it can be used simply as:
(service lightdm-service-type)
@end lisp
-A more elaborate example making use of the VNC capabilities and enabling
-more features and verbose logs could look like:
+Two more elaborate examples look like below:
@lisp
(service lightdm-service-type
@@ -23819,6 +23818,38 @@ more features and verbose logs could look like:
(name "*")
(user-session "ratpoison"))))))
@end lisp
+
+@lisp
+(service lightdm-service-type
+ (lightdm-configuration
+ (greeters
+ (list (lightdm-greeter-general-configuration
+ (greeter-package lightdm-mini-greeter)
+ (greeter-session-name "lightdm-mini-greeter")
+ (greeter-config-name "lightdm-mini-greeter.conf")
+ (config (list "[greeter]"
+ "user = guest")))
+ (lightdm-gtk-greeter-configuration
+ (extra-config
+ (list "font-name = San 10"
+ "xft-dpi = 140"
+ "clock-format = %Y-%m-%d %H:%M"
+ ;; We need to use "~~" to generate a tilde, for
+ ;; extra-config sting will be handle as
+ ;; control-string of format function.
+ "indicators = ~~host;~~spacer;~~session;~~a11y;~~clock;~~power")))))
+ (seats
+ (list (lightdm-seat-configuration
+ (name "*")
+ (greeter-session 'lightdm-mini-greeter))))
+ (xorg-configuration
+ (xorg-configuration
+ (server-arguments
+ (append %default-xorg-server-arguments
+ '("-dpi" "140")))))))
+@end lisp
+
+
@end defvar
@c The LightDM service documentation can be auto-generated via the
@@ -23903,8 +23934,21 @@ Extra configuration values to append to the LightDM configuration file.
Available @code{lightdm-gtk-greeter-configuration} fields are:
@table @asis
+@item @code{local-eval-environment} (default: @code{(the-environment)}) (type: local-eval-environment)
+Recode the environment where lightdm-gtk-greeter-configuration is defined.
+
@item @code{lightdm-gtk-greeter} (default: @code{lightdm-gtk-greeter}) (type: file-like)
-The lightdm-gtk-greeter package to use.
+The lightdm-gtk-greeter package to use, this option is keeped for
+compatibility, use greeter-package instead.
+
+@item @code{greeter-package} (default: @code{lightdm-gtk-greeter}) (type: file-like)
+The greeter package to use.
+
+@item @code{greeter-session-name} (default: @code{lightdm-gtk-greeter}) (type: string)
+The session name used in lightdm.conf.
+
+@item @code{greeter-config-name} (default: @code{lightdm-gtk-greeter.conf}) (type: string)
+The greeter config file name in /etc/lightdm directory.
@item @code{assets} (default: @code{(adwaita-icon-theme gnome-themes-extra hicolor-icon-theme)}) (type: list-of-file-likes)
The list of packages complementing the greeter, such as package
@@ -23948,6 +23992,50 @@ configuration file.
@c %end of fragment
@c %start of fragment
+@deftp {Data Type} lightdm-greeter-general-configuration
+
+@code{lightdm-greeter-general-configuration} support all text config
+greeters which have no build-in configuration type like
+@code{lightdm-gtk-greeter-configuration}, such as lightdm-mini-greeter,
+for example:
+
+@lisp
+(lightdm-greeter-general-configuration
+ (greeter-package lightdm-mini-greeter)
+ (greeter-session-name "lightdm-mini-greeter")
+ (greeter-config-name "lightdm-mini-greeter.conf")
+ (config (list "[greeter]"
+ "user = guest")))
+@end lisp
+
+Available @code{lightdm-greeter-general-configuration} fields are:
+
+@table @asis
+@item @code{local-eval-environment} (default: @code{(the-environment)}) (type: local-eval-environment)
+Recode the environment where lightdm-greeter-general-configuration is defined.
+
+@item @code{greeter-package} (type: maybe-file-like)
+The greeter package to use.
+
+@item @code{greeter-session-name} (type: maybe-string)
+The session name used in lightdm.conf.
+
+@item @code{greeter-config-name} (type: maybe-string)
+The greeter config file name in /etc/lightdm directory.
+
+@item @code{assets} (default: @code{(adwaita-icon-theme gnome-themes-extra hicolor-icon-theme)}) (type: list-of-file-likes)
+The list of packages complementing the greeter, such as package
+providing icon themes.
+
+@item @code{config} (default: @code{'()}) (type: list-of-strings)
+Configuration values of the LightDM Greeter configuration file.
+
+@end table
+@end deftp
+
+@c %end of fragment
+@c %start of fragment
+
@deftp {Data Type} lightdm-seat-configuration
Available @code{lightdm-seat-configuration} fields are:
diff --git a/gnu/services/lightdm.scm b/gnu/services/lightdm.scm
index 191cb5635b..e03549e974 100644
--- a/gnu/services/lightdm.scm
+++ b/gnu/services/lightdm.scm
@@ -39,6 +39,7 @@ (define-module (gnu services lightdm)
#:use-module (guix i18n)
#:use-module (guix records)
#:use-module (ice-9 format)
+ #:use-module (ice-9 local-eval)
#:use-module (ice-9 match)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-26)
@@ -56,7 +57,10 @@ (define-module (gnu services lightdm)
lightdm-gtk-greeter-configuration
lightdm-gtk-greeter-configuration?
lightdm-gtk-greeter-configuration-lightdm-gtk-greeter
+ lightdm-gtk-greeter-configuration-greeter-package
lightdm-gtk-greeter-configuration-assets
+ lightdm-gtk-greeter-configuration-greeter-config-name
+ lightdm-gtk-greeter-configuration-greeter-session-name
lightdm-gtk-greeter-configuration-theme-name
lightdm-gtk-greeter-configuration-icon-theme-name
lightdm-gtk-greeter-configuration-cursor-theme-name
@@ -66,6 +70,14 @@ (define-module (gnu services lightdm)
lightdm-gtk-greeter-configuration-reader
lightdm-gtk-greeter-configuration-extra-config
+ lightdm-greeter-general-configuration
+ lightdm-greeter-general-configuration?
+ lightdm-greeter-general-configuration-greeter-package
+ lightdm-greeter-general-configuration-assets
+ lightdm-greeter-general-configuration-greeter-config-name
+ lightdm-greeter-general-configuration-greeter-session-name
+ lightdm-greeter-general-configuration-config
+
lightdm-configuration
lightdm-configuration?
lightdm-configuration-lightdm
@@ -87,6 +99,9 @@ (define-module (gnu services lightdm)
;;; Greeters.
;;;
+(define (local-eval-environment? value)
+ #t)
+
(define list-of-file-likes?
(list-of file-like?))
@@ -117,6 +132,8 @@ (define (serialize-file-like name value)
(define (serialize-list-of-a11y-states name value)
(format #f "~a=~a~%" name (string-join (map symbol->string value) ";")))
+(define-maybe string)
+
(define (serialize-string name value)
(format #f "~a=~a~%" name value))
@@ -127,9 +144,21 @@ (define (serialize-list-of-strings _ value)
(string-join value "\n"))
(define-configuration lightdm-gtk-greeter-configuration
+ (local-eval-environment
+ (local-eval-environment (the-environment))
+ "Recode the environment where lightdm-gtk-greeter-configuration is defined."
+ empty-serializer)
+ (greeter-session-name
+ (string "lightdm-gtk-greeter")
+ "Session name used in lightdm.conf"
+ empty-serializer)
(lightdm-gtk-greeter
+ maybe-file-like
+ "Keep it for compatibility, use greeter-package field instead."
+ empty-serializer)
+ (greeter-package
(file-like lightdm-gtk-greeter)
- "The lightdm-gtk-greeter package to use."
+ "The greeter package to use."
empty-serializer)
(assets
(list-of-file-likes (list adwaita-icon-theme
@@ -140,6 +169,10 @@ (define-configuration lightdm-gtk-greeter-configuration
"The list of packages complementing the greeter, such as package providing
icon themes."
empty-serializer)
+ (greeter-config-name
+ (string "lightdm-gtk-greeter.conf")
+ "Greeter config file name in /etc/lightdm directory."
+ empty-serializer)
(theme-name
(string "Adwaita")
"The name of the theme to use.")
@@ -176,34 +209,81 @@ (define-configuration lightdm-gtk-greeter-configuration
"Extra configuration values to append to the LightDM GTK Greeter
configuration file."))
+(define-configuration lightdm-greeter-general-configuration
+ (local-eval-environment
+ (local-eval-environment (the-environment))
+ "Recode the environment where lightdm-greeter-general-configuration is defined."
+ empty-serializer)
+ (greeter-package
+ maybe-file-like
+ "The greeter package to use."
+ empty-serializer)
+ (assets
+ (list-of-file-likes (list adwaita-icon-theme
+ gnome-themes-extra
+ ;; FIXME: hicolor-icon-theme should be in the
+ ;; packages of the desktop templates.
+ hicolor-icon-theme))
+ "The list of packages complementing the greeter, such as package providing
+icon themes."
+ empty-serializer)
+ (greeter-config-name
+ maybe-string
+ "Greeter config file name in /etc/lightdm directory."
+ empty-serializer)
+ (greeter-session-name
+ maybe-string
+ "Session name used in lightdm.conf"
+ empty-serializer)
+ (config
+ (list-of-strings '())
+ "Configuration values of the LightDM Greeter configuration file."))
+
(define (strip-record-type-name-brackets name)
"Remove the '<' and '>' brackets from NAME, a symbol."
(let ((name (symbol->string name)))
(if (and (string-prefix? "<" name)
(string-suffix? ">" name))
- (string->symbol (string-drop (string-drop-right name 1) 1))
+ (string-drop (string-drop-right name 1) 1)
(error "unexpected record type name" name))))
-(define (config->name config)
- "Return the constructor name (a symbol) from CONFIG."
+(define (config->type-name config)
+ "Return the type name of CONFIG."
(strip-record-type-name-brackets
(record-type-name (struct-vtable config))))
+(define (greeter-configuration-field config field)
+ "Return field value of config."
+ (let ((rtd (struct-vtable config)))
+ ((record-accessor rtd field) config)))
+
+(define (greeter-configuration->session-name config)
+ "Return the session name of CONFIG, a greeter configuration."
+ (greeter-configuration-field config 'greeter-session-name))
+
(define (greeter-configuration->greeter-fields config)
"Return the fields of CONFIG, a greeter configuration."
- (match config
- ;; Note: register any new greeter configuration here.
- ((? lightdm-gtk-greeter-configuration?)
- lightdm-gtk-greeter-configuration-fields)))
+ (let* ((type-name (config->type-name config))
+ (variable (string->symbol (string-append type-name "-fields")))
+ (eval-env (greeter-configuration-field config 'local-eval-environment)))
+ (local-eval variable eval-env)))
(define (greeter-configuration->packages config)
"Return the list of greeter packages, including assets, used by CONFIG, a
greeter configuration."
- (match config
- ;; Note: register any new greeter configuration here.
- ((? lightdm-gtk-greeter-configuration?)
- (cons (lightdm-gtk-greeter-configuration-lightdm-gtk-greeter config)
- (lightdm-gtk-greeter-configuration-assets config)))))
+ (filter file-like?
+ (cons (greeter-configuration->greeter-package config)
+ (greeter-configuration-field config 'assets))))
+
+(define (greeter-configuration->greeter-package config)
+ "Return greeter package used by CONFIG, a greeter configuration."
+ (let ((type-name (config->type-name config))
+ (pkg1 (greeter-configuration-field config 'greeter-package)))
+ (if (eq? type-name "lightdm-gtk-greeter-configuration")
+ ;; Handle lightdm-gtk-greeter field for keeping it for compatibility.
+ (let ((pkg2 (greeter-configuration-field config 'lightdm-gtk-greeter)))
+ (if (file-like? pkg2) pkg2 pkg1))
+ pkg1)))
;;; TODO: Implement directly in (gnu services configuration), perhaps by
;;; making the FIELDS argument optional.
@@ -215,11 +295,19 @@ (define fields (greeter-configuration->greeter-fields config))
(define (greeter-configuration->conf-name config)
"Return the file name of CONFIG, a greeter configuration."
- (format #f "~a.conf" (greeter-configuration->greeter-session config)))
+ (greeter-configuration-field config 'greeter-config-name))
(define (greeter-configuration->file config)
"Serialize CONFIG into a file under the output directory, so that it can be
easily added to XDG_CONF_DIRS."
+ (let* ((type-name (config->type-name config))
+ (func-name (string->symbol
+ (string-append
+ "greeter-configuration->file/" type-name)))
+ (eval-env (greeter-configuration-field config 'local-eval-environment)))
+ (local-eval `(,func-name ,config) eval-env)))
+
+(define (greeter-configuration->file/lightdm-gtk-greeter-configuration config)
(computed-file
(greeter-configuration->conf-name config)
#~(begin
@@ -229,6 +317,23 @@ (define (greeter-configuration->file config)
"[greeter]\n"
#$(serialize-configuration* config))))))))
+(define (greeter-configuration->file/lightdm-greeter-general-configuration config)
+ (computed-file
+ (greeter-configuration->conf-name config)
+ #~(begin
+ (call-with-output-file #$output
+ (lambda (port)
+ (format port #$(serialize-configuration* config)))))))
+
+(define (greeter-configuration-valid? config)
+ "Check greeter-configuration CONFIG valid or not."
+ (let ((conf-name (greeter-configuration->conf-name config))
+ (session-name (greeter-configuration->session-name config)))
+ (and (string? conf-name)
+ (string? session-name)
+ (> (string-length conf-name) 0)
+ (> (string-length session-name) 0))))
+
;;;
;;; Seats.
@@ -248,15 +353,14 @@ (define (serialize-seat-type name value)
(define-maybe seat-type)
(define (greeter-session? value)
- (memq value '(lightdm-gtk-greeter)))
+ (and (symbol? value)
+ (string-contains (symbol->string value) "-greeter" )))
(define (serialize-greeter-session name value)
(format #f "~a=~a~%" name value))
(define-maybe greeter-session)
-(define-maybe string)
-
;;; Note: all the fields except for the seat name should be 'maybe's, since
;;; the real default value is set by the %lightdm-seat-default define later,
;;; and this avoids repeating ourselves in the serialized configuration file.
@@ -291,22 +395,6 @@ (define-configuration lightdm-seat-configuration
(list-of-strings '())
"Extra configuration values to append to the seat configuration section."))
-(define (greeter-session->greater-configuration-pred identifier)
- "Return the predicate to check if a configuration is of the type specifying
-a greeter identified by IDENTIFIER."
- (match identifier
- ;; Note: register any new greeter identifier here.
- ('lightdm-gtk-greeter
- lightdm-gtk-greeter-configuration?)))
-
-(define (greeter-configuration->greeter-session config)
- "Given CONFIG, a greeter configuration object, return its identifier,
-a symbol."
- (let ((suffix "-configuration")
- (greeter-conf-name (config->name config)))
- (string->symbol (string-drop-right (symbol->string greeter-conf-name)
- (string-length suffix)))))
-
(define list-of-seat-configurations?
(list-of lightdm-seat-configuration?))
@@ -316,20 +404,17 @@ (define list-of-seat-configurations?
;;;
(define (greeter-configuration? config)
- (or (lightdm-gtk-greeter-configuration? config)
- ;; Note: register any new greeter configuration here.
- ))
+ ((record-predicate (struct-vtable config)) config))
(define (list-of-greeter-configurations? greeter-configs)
(and ((list-of greeter-configuration?) greeter-configs)
;; Greeter configurations must also not be provided more than once.
- (let* ((types (map (compose record-type-name struct-vtable)
- greeter-configs))
- (dupes (filter (lambda (type)
- (< 1 (count (cut eq? type <>) types)))
- types)))
+ (let* ((conf-names (map greeter-configuration->conf-name greeter-configs))
+ (dupes (filter (lambda (conf-name)
+ (< 1 (count (cut eq? conf-name <>) conf-names)))
+ conf-names)))
(unless (null? dupes)
- (leave (G_ "duplicate greeter configurations: ~a~%") dupes)))))
+ (leave (G_ "Duplicate greeter configurations: ~a~%") dupes)))))
(define-configuration/no-serialization lightdm-configuration
(lightdm
@@ -347,7 +432,9 @@ (define-configuration/no-serialization lightdm-configuration
start script. It can be refined per seat via the @code{xserver-command} of
the @code{<lightdm-seat-configuration>} record, if desired.")
(greeters
- (list-of-greeter-configurations (list (lightdm-gtk-greeter-configuration)))
+ (list-of-greeter-configurations
+ (list (lightdm-gtk-greeter-configuration)
+ (lightdm-greeter-general-configuration)))
"The LightDM greeter configurations specifying the greeters to use.")
(seats
(list-of-seat-configurations (list (lightdm-seat-configuration
@@ -417,8 +504,11 @@ (define (validate-lightdm-configuration config)
(missing-greeters
(filter-map
(lambda (id)
- (define pred (greeter-session->greater-configuration-pred id))
- (if (find pred greeter-configurations)
+ (if (find (lambda (greeter-config)
+ (let* ((id (symbol->string id))
+ (name (greeter-configuration->session-name greeter-config)))
+ (equal? id name)))
+ greeter-configurations)
#f ;happy path
id))
greeter-sessions)))
@@ -428,10 +518,11 @@ (define pred (greeter-session->greater-configuration-pred id))
(define (lightdm-configuration-file config)
(match-record config <lightdm-configuration>
- (xorg-configuration seats
- xdmcp? xdmcp-listen-address
- vnc-server? vnc-server-command vnc-server-listen-address vnc-server-port
- extra-config)
+ (xorg-configuration
+ seats xdmcp? xdmcp-listen-address
+ vnc-server? vnc-server-command
+ vnc-server-listen-address vnc-server-port
+ extra-config)
(apply
mixed-text-file
"lightdm.conf" "
@@ -470,22 +561,22 @@ (define (lightdm-configuration-file config)
# Seat configuration.
#
"
- (map (lambda (seat)
- ;; This complication exists to propagate a default value for
- ;; the 'xserver-command' field of the seats. Having a
- ;; 'xorg-configuration' field at the root of the
- ;; lightdm-configuration enables the use of
- ;; 'set-xorg-configuration' and can be more convenient.
- (let ((seat* (if (maybe-value-set?
- (lightdm-seat-configuration-xserver-command seat))
- seat
- (lightdm-seat-configuration
- (inherit seat)
- (xserver-command (xorg-start-command
- xorg-configuration))))))
- (serialize-configuration seat*
- lightdm-seat-configuration-fields)))
- seats))))
+ (map (lambda (seat)
+ ;; This complication exists to propagate a default value for
+ ;; the 'xserver-command' field of the seats. Having a
+ ;; 'xorg-configuration' field at the root of the
+ ;; lightdm-configuration enables the use of
+ ;; 'set-xorg-configuration' and can be more convenient.
+ (let ((seat* (if (maybe-value-set?
+ (lightdm-seat-configuration-xserver-command seat))
+ seat
+ (lightdm-seat-configuration
+ (inherit seat)
+ (xserver-command (xorg-start-command
+ xorg-configuration))))))
+ (serialize-configuration seat*
+ lightdm-seat-configuration-fields)))
+ seats))))
(define (lightdm-configuration-directory config)
"Return a directory containing the serialized lightdm configuration
@@ -495,7 +586,8 @@ (define (lightdm-configuration-directory config)
(map (lambda (g)
`(,(greeter-configuration->conf-name g)
,(greeter-configuration->file g)))
- (lightdm-configuration-greeters config)))))
+ (filter greeter-configuration-valid?
+ (lightdm-configuration-greeters config))))))
(define %lightdm-accounts
(list (user-group (name "lightdm") (system? #t))
@@ -676,4 +768,5 @@ (define lightdm-service-type
(define (generate-doc)
(configuration->documentation 'lightdm-configuration)
(configuration->documentation 'lightdm-gtk-greeter-configuration)
+ (configuration->documentation 'lightdm-greeter-general-configuration)
(configuration->documentation 'lightdm-seat-configuration))
--
2.45.2
tumashu <at> 163.com, tumashu <at> 163.com, guix-patches <at> gnu.org:bug#75048; Package guix-patches.
(Wed, 25 Dec 2024 06:04:01 GMT) Full text and rfc822 format available.Message #17 received at 75048 <at> debbugs.gnu.org (full text, mbox):
From: tumashu <at> 163.com To: 75048 <at> debbugs.gnu.org Cc: Feng Shu <tumashu <at> 163.com> Subject: [PATCH v5] Add lightdm-greeter-general-configuration and do not hard code config type name everywhere. Date: Wed, 25 Dec 2024 14:03:15 +0800
From: Feng Shu <tumashu <at> 163.com>
* gnu/services/lightdm.scm (gnu): Use (ice-9 local-eval), export new option variables.
(local-eval-environment?): New variable.
(string): Move.
(lightdm-gtk-greeter-configuration): Add local-eval-environment,
greeter-session-name, greeter-package, greeter-config-name fields.
(lightdm-greeter-general-configuration): New variable.
(strip-record-type-name-brackets): Return string instead symbol.
(config->type-name): Rename from config->name.
(greeter-configuration-field): New function.
(greeter-configuration->greeter-fields): Do not hard code greeter configuation name.
(greeter-configuration->packages): Do not hard code greeter configuation name.
(greeter-configuration->conf-name): Improve.
(greeter-configuration->session-name): New variable.
(greeter-configuration->file): Call different function based config type.
(greeter-configuration->file/lightdm-gtk-greeter-configuration)
(greeter-configuration->file/lightdm-greeter-general-configuration): New functions.
(greeter-configuration-valid?): New function.
(greeter-session?): Do not hard code greeter configuation name.
(greeter-session->greater-configuration-pred)
(greeter-configuration->greeter-session): Removed.
(greeter-configuration?): Do not hard code greeter configuation name.
(lightdm-configuration): Add lightdm-greeter-general-configuration.
(validate-lightdm-configuration): Do not use greeter-session->greater-configuration-pred.
(generate-doc): Handle lightdm-greeter-general-configuration.
* doc/guix.texi (X Window): Improve lightdm-gtk-greeter-configuration options
doc, Add lightdm-greeter-general-configuration,
Change-Id: Iae22cd641454c86280e88d6986594ad0c8f4c490
---
doc/guix.texi | 94 +++++++++++++++-
gnu/services/lightdm.scm | 225 +++++++++++++++++++++++++++------------
2 files changed, 250 insertions(+), 69 deletions(-)
diff --git a/doc/guix.texi b/doc/guix.texi
index 31deb5b003..e1f1fee68b 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -23802,8 +23802,7 @@ In its most basic form, it can be used simply as:
(service lightdm-service-type)
@end lisp
-A more elaborate example making use of the VNC capabilities and enabling
-more features and verbose logs could look like:
+Two more elaborate examples look like below:
@lisp
(service lightdm-service-type
@@ -23819,6 +23818,38 @@ more features and verbose logs could look like:
(name "*")
(user-session "ratpoison"))))))
@end lisp
+
+@lisp
+(service lightdm-service-type
+ (lightdm-configuration
+ (greeters
+ (list (lightdm-greeter-general-configuration
+ (greeter-package lightdm-mini-greeter)
+ (greeter-session-name "lightdm-mini-greeter")
+ (greeter-config-name "lightdm-mini-greeter.conf")
+ (config (list "[greeter]"
+ "user = guest")))
+ (lightdm-gtk-greeter-configuration
+ (extra-config
+ (list "font-name = San 10"
+ "xft-dpi = 140"
+ "clock-format = %Y-%m-%d %H:%M"
+ ;; We need to use "~~" to generate a tilde, for
+ ;; extra-config sting will be handle as
+ ;; control-string of format function.
+ "indicators = ~~host;~~spacer;~~session;~~a11y;~~clock;~~power")))))
+ (seats
+ (list (lightdm-seat-configuration
+ (name "*")
+ (greeter-session 'lightdm-mini-greeter))))
+ (xorg-configuration
+ (xorg-configuration
+ (server-arguments
+ (append %default-xorg-server-arguments
+ '("-dpi" "140")))))))
+@end lisp
+
+
@end defvar
@c The LightDM service documentation can be auto-generated via the
@@ -23903,8 +23934,21 @@ Extra configuration values to append to the LightDM configuration file.
Available @code{lightdm-gtk-greeter-configuration} fields are:
@table @asis
+@item @code{local-eval-environment} (default: @code{(the-environment)}) (type: local-eval-environment)
+Recode the environment where lightdm-gtk-greeter-configuration is defined.
+
@item @code{lightdm-gtk-greeter} (default: @code{lightdm-gtk-greeter}) (type: file-like)
-The lightdm-gtk-greeter package to use.
+The lightdm-gtk-greeter package to use, this option is keeped for
+compatibility, use greeter-package instead.
+
+@item @code{greeter-package} (default: @code{lightdm-gtk-greeter}) (type: file-like)
+The greeter package to use.
+
+@item @code{greeter-session-name} (default: @code{lightdm-gtk-greeter}) (type: string)
+The session name used in lightdm.conf.
+
+@item @code{greeter-config-name} (default: @code{lightdm-gtk-greeter.conf}) (type: string)
+The greeter config file name in /etc/lightdm directory.
@item @code{assets} (default: @code{(adwaita-icon-theme gnome-themes-extra hicolor-icon-theme)}) (type: list-of-file-likes)
The list of packages complementing the greeter, such as package
@@ -23948,6 +23992,50 @@ configuration file.
@c %end of fragment
@c %start of fragment
+@deftp {Data Type} lightdm-greeter-general-configuration
+
+@code{lightdm-greeter-general-configuration} support all text config
+greeters which have no build-in configuration type like
+@code{lightdm-gtk-greeter-configuration}, such as lightdm-mini-greeter,
+for example:
+
+@lisp
+(lightdm-greeter-general-configuration
+ (greeter-package lightdm-mini-greeter)
+ (greeter-session-name "lightdm-mini-greeter")
+ (greeter-config-name "lightdm-mini-greeter.conf")
+ (config (list "[greeter]"
+ "user = guest")))
+@end lisp
+
+Available @code{lightdm-greeter-general-configuration} fields are:
+
+@table @asis
+@item @code{local-eval-environment} (default: @code{(the-environment)}) (type: local-eval-environment)
+Recode the environment where lightdm-greeter-general-configuration is defined.
+
+@item @code{greeter-package} (type: maybe-file-like)
+The greeter package to use.
+
+@item @code{greeter-session-name} (type: maybe-string)
+The session name used in lightdm.conf.
+
+@item @code{greeter-config-name} (type: maybe-string)
+The greeter config file name in /etc/lightdm directory.
+
+@item @code{assets} (default: @code{(adwaita-icon-theme gnome-themes-extra hicolor-icon-theme)}) (type: list-of-file-likes)
+The list of packages complementing the greeter, such as package
+providing icon themes.
+
+@item @code{config} (default: @code{'()}) (type: list-of-strings)
+Configuration values of the LightDM Greeter configuration file.
+
+@end table
+@end deftp
+
+@c %end of fragment
+@c %start of fragment
+
@deftp {Data Type} lightdm-seat-configuration
Available @code{lightdm-seat-configuration} fields are:
diff --git a/gnu/services/lightdm.scm b/gnu/services/lightdm.scm
index 191cb5635b..e59a4ceb6e 100644
--- a/gnu/services/lightdm.scm
+++ b/gnu/services/lightdm.scm
@@ -39,6 +39,7 @@ (define-module (gnu services lightdm)
#:use-module (guix i18n)
#:use-module (guix records)
#:use-module (ice-9 format)
+ #:use-module (ice-9 local-eval)
#:use-module (ice-9 match)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-26)
@@ -56,7 +57,10 @@ (define-module (gnu services lightdm)
lightdm-gtk-greeter-configuration
lightdm-gtk-greeter-configuration?
lightdm-gtk-greeter-configuration-lightdm-gtk-greeter
+ lightdm-gtk-greeter-configuration-greeter-package
lightdm-gtk-greeter-configuration-assets
+ lightdm-gtk-greeter-configuration-greeter-config-name
+ lightdm-gtk-greeter-configuration-greeter-session-name
lightdm-gtk-greeter-configuration-theme-name
lightdm-gtk-greeter-configuration-icon-theme-name
lightdm-gtk-greeter-configuration-cursor-theme-name
@@ -66,6 +70,14 @@ (define-module (gnu services lightdm)
lightdm-gtk-greeter-configuration-reader
lightdm-gtk-greeter-configuration-extra-config
+ lightdm-greeter-general-configuration
+ lightdm-greeter-general-configuration?
+ lightdm-greeter-general-configuration-greeter-package
+ lightdm-greeter-general-configuration-assets
+ lightdm-greeter-general-configuration-greeter-config-name
+ lightdm-greeter-general-configuration-greeter-session-name
+ lightdm-greeter-general-configuration-config
+
lightdm-configuration
lightdm-configuration?
lightdm-configuration-lightdm
@@ -87,6 +99,9 @@ (define-module (gnu services lightdm)
;;; Greeters.
;;;
+(define (local-eval-environment? value)
+ #t)
+
(define list-of-file-likes?
(list-of file-like?))
@@ -117,6 +132,8 @@ (define (serialize-file-like name value)
(define (serialize-list-of-a11y-states name value)
(format #f "~a=~a~%" name (string-join (map symbol->string value) ";")))
+(define-maybe string)
+
(define (serialize-string name value)
(format #f "~a=~a~%" name value))
@@ -127,9 +144,21 @@ (define (serialize-list-of-strings _ value)
(string-join value "\n"))
(define-configuration lightdm-gtk-greeter-configuration
+ (local-eval-environment
+ (local-eval-environment (the-environment))
+ "Recode the environment where lightdm-gtk-greeter-configuration is defined."
+ empty-serializer)
+ (greeter-session-name
+ (string "lightdm-gtk-greeter")
+ "Session name used in lightdm.conf"
+ empty-serializer)
(lightdm-gtk-greeter
+ maybe-file-like
+ "Keep it for compatibility, use greeter-package field instead."
+ empty-serializer)
+ (greeter-package
(file-like lightdm-gtk-greeter)
- "The lightdm-gtk-greeter package to use."
+ "The greeter package to use."
empty-serializer)
(assets
(list-of-file-likes (list adwaita-icon-theme
@@ -140,6 +169,10 @@ (define-configuration lightdm-gtk-greeter-configuration
"The list of packages complementing the greeter, such as package providing
icon themes."
empty-serializer)
+ (greeter-config-name
+ (string "lightdm-gtk-greeter.conf")
+ "Greeter config file name in /etc/lightdm directory."
+ empty-serializer)
(theme-name
(string "Adwaita")
"The name of the theme to use.")
@@ -176,34 +209,81 @@ (define-configuration lightdm-gtk-greeter-configuration
"Extra configuration values to append to the LightDM GTK Greeter
configuration file."))
+(define-configuration lightdm-greeter-general-configuration
+ (local-eval-environment
+ (local-eval-environment (the-environment))
+ "Recode the environment where lightdm-greeter-general-configuration is defined."
+ empty-serializer)
+ (greeter-package
+ maybe-file-like
+ "The greeter package to use."
+ empty-serializer)
+ (assets
+ (list-of-file-likes (list adwaita-icon-theme
+ gnome-themes-extra
+ ;; FIXME: hicolor-icon-theme should be in the
+ ;; packages of the desktop templates.
+ hicolor-icon-theme))
+ "The list of packages complementing the greeter, such as package providing
+icon themes."
+ empty-serializer)
+ (greeter-config-name
+ maybe-string
+ "Greeter config file name in /etc/lightdm directory."
+ empty-serializer)
+ (greeter-session-name
+ maybe-string
+ "Session name used in lightdm.conf"
+ empty-serializer)
+ (config
+ (list-of-strings '())
+ "Configuration values of the LightDM Greeter configuration file."))
+
(define (strip-record-type-name-brackets name)
"Remove the '<' and '>' brackets from NAME, a symbol."
(let ((name (symbol->string name)))
(if (and (string-prefix? "<" name)
(string-suffix? ">" name))
- (string->symbol (string-drop (string-drop-right name 1) 1))
+ (string-drop (string-drop-right name 1) 1)
(error "unexpected record type name" name))))
-(define (config->name config)
- "Return the constructor name (a symbol) from CONFIG."
+(define (config->type-name config)
+ "Return the type name of CONFIG."
(strip-record-type-name-brackets
(record-type-name (struct-vtable config))))
+(define (greeter-configuration-field config field)
+ "Return field value of config."
+ (let ((rtd (struct-vtable config)))
+ ((record-accessor rtd field) config)))
+
+(define (greeter-configuration->session-name config)
+ "Return the session name of CONFIG, a greeter configuration."
+ (greeter-configuration-field config 'greeter-session-name))
+
(define (greeter-configuration->greeter-fields config)
"Return the fields of CONFIG, a greeter configuration."
- (match config
- ;; Note: register any new greeter configuration here.
- ((? lightdm-gtk-greeter-configuration?)
- lightdm-gtk-greeter-configuration-fields)))
+ (let* ((type-name (config->type-name config))
+ (variable (string->symbol (string-append type-name "-fields")))
+ (eval-env (greeter-configuration-field config 'local-eval-environment)))
+ (local-eval variable eval-env)))
(define (greeter-configuration->packages config)
"Return the list of greeter packages, including assets, used by CONFIG, a
greeter configuration."
- (match config
- ;; Note: register any new greeter configuration here.
- ((? lightdm-gtk-greeter-configuration?)
- (cons (lightdm-gtk-greeter-configuration-lightdm-gtk-greeter config)
- (lightdm-gtk-greeter-configuration-assets config)))))
+ (filter file-like?
+ (cons (greeter-configuration->greeter-package config)
+ (greeter-configuration-field config 'assets))))
+
+(define (greeter-configuration->greeter-package config)
+ "Return greeter package used by CONFIG, a greeter configuration."
+ (let ((type-name (config->type-name config))
+ (pkg1 (greeter-configuration-field config 'greeter-package)))
+ (if (eq? type-name "lightdm-gtk-greeter-configuration")
+ ;; Handle lightdm-gtk-greeter field for keeping it for compatibility.
+ (let ((pkg2 (greeter-configuration-field config 'lightdm-gtk-greeter)))
+ (if (file-like? pkg2) pkg2 pkg1))
+ pkg1)))
;;; TODO: Implement directly in (gnu services configuration), perhaps by
;;; making the FIELDS argument optional.
@@ -215,11 +295,19 @@ (define fields (greeter-configuration->greeter-fields config))
(define (greeter-configuration->conf-name config)
"Return the file name of CONFIG, a greeter configuration."
- (format #f "~a.conf" (greeter-configuration->greeter-session config)))
+ (greeter-configuration-field config 'greeter-config-name))
(define (greeter-configuration->file config)
"Serialize CONFIG into a file under the output directory, so that it can be
easily added to XDG_CONF_DIRS."
+ (let* ((type-name (config->type-name config))
+ (func-name (string->symbol
+ (string-append
+ "greeter-configuration->file/" type-name)))
+ (eval-env (greeter-configuration-field config 'local-eval-environment)))
+ (local-eval `(,func-name ,config) eval-env)))
+
+(define (greeter-configuration->file/lightdm-gtk-greeter-configuration config)
(computed-file
(greeter-configuration->conf-name config)
#~(begin
@@ -229,6 +317,23 @@ (define (greeter-configuration->file config)
"[greeter]\n"
#$(serialize-configuration* config))))))))
+(define (greeter-configuration->file/lightdm-greeter-general-configuration config)
+ (computed-file
+ (greeter-configuration->conf-name config)
+ #~(begin
+ (call-with-output-file #$output
+ (lambda (port)
+ (format port #$(serialize-configuration* config)))))))
+
+(define (greeter-configuration-valid? config)
+ "Check greeter-configuration CONFIG valid or not."
+ (let ((conf-name (greeter-configuration->conf-name config))
+ (session-name (greeter-configuration->session-name config)))
+ (and (string? conf-name)
+ (string? session-name)
+ (> (string-length conf-name) 0)
+ (> (string-length session-name) 0))))
+
;;;
;;; Seats.
@@ -248,15 +353,14 @@ (define (serialize-seat-type name value)
(define-maybe seat-type)
(define (greeter-session? value)
- (memq value '(lightdm-gtk-greeter)))
+ (and (symbol? value)
+ (string-contains (symbol->string value) "greeter")))
(define (serialize-greeter-session name value)
(format #f "~a=~a~%" name value))
(define-maybe greeter-session)
-(define-maybe string)
-
;;; Note: all the fields except for the seat name should be 'maybe's, since
;;; the real default value is set by the %lightdm-seat-default define later,
;;; and this avoids repeating ourselves in the serialized configuration file.
@@ -291,22 +395,6 @@ (define-configuration lightdm-seat-configuration
(list-of-strings '())
"Extra configuration values to append to the seat configuration section."))
-(define (greeter-session->greater-configuration-pred identifier)
- "Return the predicate to check if a configuration is of the type specifying
-a greeter identified by IDENTIFIER."
- (match identifier
- ;; Note: register any new greeter identifier here.
- ('lightdm-gtk-greeter
- lightdm-gtk-greeter-configuration?)))
-
-(define (greeter-configuration->greeter-session config)
- "Given CONFIG, a greeter configuration object, return its identifier,
-a symbol."
- (let ((suffix "-configuration")
- (greeter-conf-name (config->name config)))
- (string->symbol (string-drop-right (symbol->string greeter-conf-name)
- (string-length suffix)))))
-
(define list-of-seat-configurations?
(list-of lightdm-seat-configuration?))
@@ -316,20 +404,17 @@ (define list-of-seat-configurations?
;;;
(define (greeter-configuration? config)
- (or (lightdm-gtk-greeter-configuration? config)
- ;; Note: register any new greeter configuration here.
- ))
+ ((record-predicate (struct-vtable config)) config))
(define (list-of-greeter-configurations? greeter-configs)
(and ((list-of greeter-configuration?) greeter-configs)
;; Greeter configurations must also not be provided more than once.
- (let* ((types (map (compose record-type-name struct-vtable)
- greeter-configs))
- (dupes (filter (lambda (type)
- (< 1 (count (cut eq? type <>) types)))
- types)))
+ (let* ((conf-names (map greeter-configuration->conf-name greeter-configs))
+ (dupes (filter (lambda (conf-name)
+ (< 1 (count (cut eq? conf-name <>) conf-names)))
+ conf-names)))
(unless (null? dupes)
- (leave (G_ "duplicate greeter configurations: ~a~%") dupes)))))
+ (leave (G_ "Duplicate greeter configurations: ~a~%") dupes)))))
(define-configuration/no-serialization lightdm-configuration
(lightdm
@@ -347,7 +432,9 @@ (define-configuration/no-serialization lightdm-configuration
start script. It can be refined per seat via the @code{xserver-command} of
the @code{<lightdm-seat-configuration>} record, if desired.")
(greeters
- (list-of-greeter-configurations (list (lightdm-gtk-greeter-configuration)))
+ (list-of-greeter-configurations
+ (list (lightdm-gtk-greeter-configuration)
+ (lightdm-greeter-general-configuration)))
"The LightDM greeter configurations specifying the greeters to use.")
(seats
(list-of-seat-configurations (list (lightdm-seat-configuration
@@ -417,8 +504,11 @@ (define (validate-lightdm-configuration config)
(missing-greeters
(filter-map
(lambda (id)
- (define pred (greeter-session->greater-configuration-pred id))
- (if (find pred greeter-configurations)
+ (if (find (lambda (greeter-config)
+ (let* ((id (symbol->string id))
+ (name (greeter-configuration->session-name greeter-config)))
+ (equal? id name)))
+ greeter-configurations)
#f ;happy path
id))
greeter-sessions)))
@@ -428,10 +518,11 @@ (define pred (greeter-session->greater-configuration-pred id))
(define (lightdm-configuration-file config)
(match-record config <lightdm-configuration>
- (xorg-configuration seats
- xdmcp? xdmcp-listen-address
- vnc-server? vnc-server-command vnc-server-listen-address vnc-server-port
- extra-config)
+ (xorg-configuration
+ seats xdmcp? xdmcp-listen-address
+ vnc-server? vnc-server-command
+ vnc-server-listen-address vnc-server-port
+ extra-config)
(apply
mixed-text-file
"lightdm.conf" "
@@ -470,22 +561,22 @@ (define (lightdm-configuration-file config)
# Seat configuration.
#
"
- (map (lambda (seat)
- ;; This complication exists to propagate a default value for
- ;; the 'xserver-command' field of the seats. Having a
- ;; 'xorg-configuration' field at the root of the
- ;; lightdm-configuration enables the use of
- ;; 'set-xorg-configuration' and can be more convenient.
- (let ((seat* (if (maybe-value-set?
- (lightdm-seat-configuration-xserver-command seat))
- seat
- (lightdm-seat-configuration
- (inherit seat)
- (xserver-command (xorg-start-command
- xorg-configuration))))))
- (serialize-configuration seat*
- lightdm-seat-configuration-fields)))
- seats))))
+ (map (lambda (seat)
+ ;; This complication exists to propagate a default value for
+ ;; the 'xserver-command' field of the seats. Having a
+ ;; 'xorg-configuration' field at the root of the
+ ;; lightdm-configuration enables the use of
+ ;; 'set-xorg-configuration' and can be more convenient.
+ (let ((seat* (if (maybe-value-set?
+ (lightdm-seat-configuration-xserver-command seat))
+ seat
+ (lightdm-seat-configuration
+ (inherit seat)
+ (xserver-command (xorg-start-command
+ xorg-configuration))))))
+ (serialize-configuration seat*
+ lightdm-seat-configuration-fields)))
+ seats))))
(define (lightdm-configuration-directory config)
"Return a directory containing the serialized lightdm configuration
@@ -495,7 +586,8 @@ (define (lightdm-configuration-directory config)
(map (lambda (g)
`(,(greeter-configuration->conf-name g)
,(greeter-configuration->file g)))
- (lightdm-configuration-greeters config)))))
+ (filter greeter-configuration-valid?
+ (lightdm-configuration-greeters config))))))
(define %lightdm-accounts
(list (user-group (name "lightdm") (system? #t))
@@ -676,4 +768,5 @@ (define lightdm-service-type
(define (generate-doc)
(configuration->documentation 'lightdm-configuration)
(configuration->documentation 'lightdm-gtk-greeter-configuration)
+ (configuration->documentation 'lightdm-greeter-general-configuration)
(configuration->documentation 'lightdm-seat-configuration))
--
2.45.2
tumashu <at> 163.com, tumashu <at> 163.com, guix-patches <at> gnu.org:bug#75048; Package guix-patches.
(Mon, 30 Dec 2024 00:35:01 GMT) Full text and rfc822 format available.Message #20 received at 75048 <at> debbugs.gnu.org (full text, mbox):
From: tumashu <at> 163.com To: 75048 <at> debbugs.gnu.org Cc: Feng Shu <tumashu <at> 163.com> Subject: [PATCH v6] Add lightdm-greeter-general-configuration and do not hard code config type name everywhere. Date: Mon, 30 Dec 2024 08:34:20 +0800
From: Feng Shu <tumashu <at> 163.com>
* 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
guix-patches <at> gnu.org:bug#75048; Package guix-patches.
(Mon, 30 Dec 2024 01:47:03 GMT) Full text and rfc822 format available.Message #23 received at 75048 <at> debbugs.gnu.org (full text, mbox):
From: Feng Shu <tumashu <at> 163.com> To: 75043 <at> debbugs.gnu.org, 75044 <at> debbugs.gnu.org, 75048 <at> debbugs.gnu.org Subject: Please review this patch. Date: Mon, 30 Dec 2024 09:46:27 +0800
Please review this patch, thanks. --
tumashu <at> 163.com, tumashu <at> 163.com, guix-patches <at> gnu.org:bug#75048; Package guix-patches.
(Fri, 03 Jan 2025 02:29:02 GMT) Full text and rfc822 format available.Message #26 received at 75048 <at> debbugs.gnu.org (full text, mbox):
From: tumashu <at> 163.com To: 75048 <at> debbugs.gnu.org Cc: Feng Shu <tumashu <at> 163.com> Subject: [PATCH v7] Add lightdm-greeter-general-configuration and do not hard code config type name everywhere. Date: Fri, 3 Jan 2025 10:27:53 +0800
From: Feng Shu <tumashu <at> 163.com>
* 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
guix-patches <at> gnu.org:bug#75048; Package guix-patches.
(Fri, 03 Jan 2025 02:32:02 GMT) Full text and rfc822 format available.Message #29 received at 75048 <at> debbugs.gnu.org (full text, mbox):
From: Feng Shu <tumashu <at> 163.com> To: 75048 <at> debbugs.gnu.org Subject: Re: [PATCH] Add lightdm-greeter-general-configuration and do not hard code config type name everywhere. Date: Fri, 03 Jan 2025 10:31:13 +0800
In v7 patch, I do not use local-eval, which simplify code a lot. --
guix-patches <at> gnu.org:bug#75048; Package guix-patches.
(Mon, 03 Mar 2025 22:15:02 GMT) Full text and rfc822 format available.Message #32 received at 75048 <at> debbugs.gnu.org (full text, mbox):
From: Feng Shu <tumashu <at> 163.com> To: 75048 <at> debbugs.gnu.org Subject: Re: [PATCH v7] Add lightdm-greeter-general-configuration and do not hard code config type name everywhere. Date: Tue, 04 Mar 2025 06:14:19 +0800
ping :-)
GNU bug tracking system
Copyright (C) 1999 Darren O. Benham,
1997,2003 nCipher Corporation Ltd,
1994-97 Ian Jackson.