(address . guix-patches@gnu.org)
87pllibkr3.fsf@163.com
From 0a49889ee8ceda8c311a12c9f1e1f44cecb3e100 Mon Sep 17 00:00:00 2001
From: Feng Shu <tumashu@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(-)
Toggle diff (432 lines)
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
--