From 4a84a48742ab9e15d7d527c3d965f907ec40672c Mon Sep 17 00:00:00 2001
From: Ludovic Courtès <ludo@gnu.org>
Date: Mon, 19 Sep 2016 23:36:17 +0900
Subject: services: console-font: A single service handles all the VTs.

* gnu/services/base.scm (%default-console-font): New variable.
(console-font-shepherd-services): New procedure.
(console-font-service-type): Change to use 'service-type'.
(console-font-service): Rewrite using 'simple-service'.
(%base-services): Use a single CONSOLE-FONT-SERVICE-TYPE instance.
* gnu/system/install.scm (installation-services): Likewise.
---
 gnu/services/base.scm | 80 ++++++++++++++++++++++++++++++---------------------
 1 file changed, 47 insertions(+), 33 deletions(-)

(limited to 'gnu/services/base.scm')

diff --git a/gnu/services/base.scm b/gnu/services/base.scm
index 4c1c481453..afbecdb47e 100644
--- a/gnu/services/base.scm
+++ b/gnu/services/base.scm
@@ -58,6 +58,8 @@ (define-module (gnu services base)
             session-environment-service-type
             host-name-service
             console-keymap-service
+            %default-console-font
+            console-font-service-type
             console-font-service
 
             udev-configuration
@@ -635,37 +637,51 @@ (define (console-keymap-service . files)
   "Return a service to load console keymaps from @var{files}."
   (service console-keymap-service-type files))
 
-(define console-font-service-type
-  (shepherd-service-type
-   'console-font
-   (match-lambda
-     ((tty font)
-      (let ((device (string-append "/dev/" tty)))
-        (shepherd-service
-         (documentation "Load a Unicode console font.")
-         (provision (list (symbol-append 'console-font-
-                                         (string->symbol tty))))
-
-         ;; Start after mingetty has been started on TTY, otherwise the settings
-         ;; are ignored.
-         (requirement (list (symbol-append 'term-
-                                           (string->symbol tty))))
+(define %default-console-font
+  ;; Note: 'LatGrkCyr-8x16' has the advantage of providing three common
+  ;; scripts as well as glyphs for em dash, quotation marks, and other Unicode
+  ;; codepoints notably found in the UTF-8 manual.
+  "LatGrkCyr-8x16")
+
+(define (console-font-shepherd-services tty+font)
+  "Return a list of Shepherd services for each pair in TTY+FONT."
+  (map (match-lambda
+         ((tty . font)
+          (let ((device (string-append "/dev/" tty)))
+            (shepherd-service
+             (documentation "Load a Unicode console font.")
+             (provision (list (symbol-append 'console-font-
+                                             (string->symbol tty))))
+
+             ;; Start after mingetty has been started on TTY, otherwise the settings
+             ;; are ignored.
+             (requirement (list (symbol-append 'term-
+                                               (string->symbol tty))))
+
+             (start #~(lambda _
+                        (and #$(unicode-start device)
+                             (zero?
+                              (system* (string-append #$kbd "/bin/setfont")
+                                       "-C" #$device #$font)))))
+             (stop #~(const #t))
+             (respawn? #f)))))
+       tty+font))
 
-         (start #~(lambda _
-                    (and #$(unicode-start device)
-                         (zero?
-                          (system* (string-append #$kbd "/bin/setfont")
-                                   "-C" #$device #$font)))))
-         (stop #~(const #t))
-         (respawn? #f)))))))
+(define console-font-service-type
+  (service-type (name 'console-fonts)
+                (extensions
+                 (list (service-extension shepherd-root-service-type
+                                          console-font-shepherd-services)))
+                (compose concatenate)
+                (extend append)))
 
 (define* (console-font-service tty #:optional (font "LatGrkCyr-8x16"))
-  "Return a service that sets up Unicode support in @var{tty} and loads
+  "This procedure is deprecated in favor of @code{console-font-service-type}.
+
+Return a service that sets up Unicode support in @var{tty} and loads
 @var{font} for that tty (fonts are per virtual console in Linux.)"
-  ;; Note: 'LatGrkCyr-8x16' has the advantage of providing three common
-  ;; scripts as well as glyphs for em dash, quotation marks, and other Unicode
-  ;; codepoints notably found in the UTF-8 manual.
-  (service console-font-service-type (list tty font)))
+  (simple-service (symbol-append 'console-font- (string->symbol tty))
+                  console-font-service-type `((,tty . ,font))))
 
 (define %default-motd
   (plain-file "motd" "This is the GNU operating system, welcome!\n\n"))
@@ -1497,12 +1513,10 @@ (define %base-services
   ;; Convenience variable holding the basic services.
   (list (login-service)
 
-        (console-font-service "tty1")
-        (console-font-service "tty2")
-        (console-font-service "tty3")
-        (console-font-service "tty4")
-        (console-font-service "tty5")
-        (console-font-service "tty6")
+        (service console-font-service-type
+                 (map (lambda (tty)
+                        (cons tty %default-console-font))
+                      '("tty1" "tty2" "tty3" "tty4" "tty5" "tty6")))
 
         (mingetty-service (mingetty-configuration
                            (tty "tty1")))
-- 
cgit v1.2.3