diff options
author | Ludovic Courtès <ludo@gnu.org> | 2016-09-19 23:36:17 +0900 |
---|---|---|
committer | Ludovic Courtès <ludo@gnu.org> | 2016-09-19 23:36:17 +0900 |
commit | 4a84a48742ab9e15d7d527c3d965f907ec40672c (patch) | |
tree | a8f6b60e1625736e2bd629e9f7cfeed4b00ca9c4 | |
parent | 71654dfdda4890d7a663a36a7fe754b53591aba6 (diff) | |
download | 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.scm | 80 | ||||
-rw-r--r-- | gnu/system/install.scm | 10 |
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) |