aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--gnu/services/base.scm56
-rw-r--r--gnu/system/install.scm12
2 files changed, 65 insertions, 3 deletions
diff --git a/gnu/services/base.scm b/gnu/services/base.scm
index a3944dbdfa..55ee5c4b08 100644
--- a/gnu/services/base.scm
+++ b/gnu/services/base.scm
@@ -25,7 +25,7 @@
#:use-module (gnu system linux) ; 'pam-service', etc.
#:use-module (gnu packages admin)
#:use-module ((gnu packages linux)
- #:select (udev))
+ #:select (udev kbd))
#:use-module ((gnu packages base)
#:select (glibc-final))
#:use-module (gnu packages package-management)
@@ -38,6 +38,7 @@
file-system-service
user-processes-service
host-name-service
+ console-font-service
udev-service
mingetty-service
nscd-service
@@ -199,6 +200,50 @@ stopped before 'kill' is called."
(sethostname #$name)))
(respawn? #f)))))
+(define (unicode-start tty)
+ "Return a gexp to start Unicode support on @var{tty}."
+
+ ;; We have to run 'unicode_start' in a pipe so that when it invokes the
+ ;; 'tty' command, that command returns TTY.
+ #~(begin
+ (let ((pid (primitive-fork)))
+ (case pid
+ ((0)
+ (close-fdes 0)
+ (dup2 (open-fdes #$tty O_RDONLY) 0)
+ (close-fdes 1)
+ (dup2 (open-fdes #$tty O_WRONLY) 1)
+ (execl (string-append #$kbd "/bin/unicode_start")
+ "unicode_start"))
+ (else
+ (zero? (cdr (waitpid pid))))))))
+
+(define* (console-font-service tty #:optional (font "LatGrkCyr-8x16"))
+ "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.
+ (let ((device (string-append "/dev/" tty)))
+ (with-monad %store-monad
+ (return (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))))))
+
(define* (mingetty-service tty
#:key
(motd (text-file "motd" "Welcome.\n"))
@@ -469,7 +514,14 @@ passed to @command{guix-daemon}."
;; Convenience variable holding the basic services.
(let ((motd (text-file "motd" "
This is the GNU operating system, welcome!\n\n")))
- (list (mingetty-service "tty1" #:motd motd)
+ (list (console-font-service "tty1")
+ (console-font-service "tty2")
+ (console-font-service "tty3")
+ (console-font-service "tty4")
+ (console-font-service "tty5")
+ (console-font-service "tty6")
+
+ (mingetty-service "tty1" #:motd motd)
(mingetty-service "tty2" #:motd motd)
(mingetty-service "tty3" #:motd motd)
(mingetty-service "tty4" #:motd motd)
diff --git a/gnu/system/install.scm b/gnu/system/install.scm
index b30c5577e4..3fbfaf6d77 100644
--- a/gnu/system/install.scm
+++ b/gnu/system/install.scm
@@ -63,7 +63,9 @@ You have been warned. Thanks for being so brave.
#:motd motd
#:auto-login "root")
- ;; Documentation.
+ ;; Documentation. The manual is in UTF-8, but
+ ;; 'console-font-service' sets up Unicode support and loads a font
+ ;; with all the useful glyphs like em dash and quotation marks.
(mingetty-service "tty2"
#:motd motd
#:auto-login "guest"
@@ -86,6 +88,14 @@ You have been warned. Thanks for being so brave.
;; Start udev so that useful device nodes are available.
(udev-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")
+
(nscd-service))))
(define %issue