aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2016-09-19 23:36:17 +0900
committerLudovic Courtès <ludo@gnu.org>2016-09-19 23:36:17 +0900
commit4a84a48742ab9e15d7d527c3d965f907ec40672c (patch)
treea8f6b60e1625736e2bd629e9f7cfeed4b00ca9c4
parent71654dfdda4890d7a663a36a7fe754b53591aba6 (diff)
downloadguix-4a84a48742ab9e15d7d527c3d965f907ec40672c.tar
guix-4a84a48742ab9e15d7d527c3d965f907ec40672c.tar.gz
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.
-rw-r--r--gnu/services/base.scm80
-rw-r--r--gnu/system/install.scm10
2 files changed, 51 insertions, 39 deletions
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 @@
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 @@ strings or string-valued gexps."
"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 @@ This service is not part of @var{%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")))
diff --git a/gnu/system/install.scm b/gnu/system/install.scm
index b28925f432..dfa003f256 100644
--- a/gnu/system/install.scm
+++ b/gnu/system/install.scm
@@ -313,12 +313,10 @@ You have been warned. Thanks for being so brave.
(cow-store-service)
;; Install Unicode support and a suitable font.
- (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")))
;; To facilitate copy/paste.
(gpm-service)