~ruther/guix-local

62ca0fdf9e3b76f964bc953bfc39511c41be27b5 — Ludovic Courtès 11 years ago 2cf0ea0
services: Add 'console-font-service'.

* gnu/services/base.scm (unicode-start, console-font-service): New
  procedures.
  (%base-services): Call 'console-font-service' for TTY1 to TTY6.
* gnu/system/install.scm (installation-services): Add comment about the
  console font.  Call 'console-font-service' for TTY1 to TTY6.
2 files changed, 65 insertions(+), 3 deletions(-)

M gnu/services/base.scm
M gnu/system/install.scm
M gnu/services/base.scm => gnu/services/base.scm +54 -2
@@ 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)

M gnu/system/install.scm => gnu/system/install.scm +11 -1
@@ 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