From d0f3a672dcbdfefd3556b6a21985ff0e35eed3be Mon Sep 17 00:00:00 2001 From: Mathieu Othacehe Date: Fri, 16 Nov 2018 20:43:55 +0900 Subject: gnu: Add graphical installer support. * configure.ac: Require that guile-newt is available. * gnu/installer.scm: New file. * gnu/installer/aux-files/logo.txt: New file. * gnu/installer/build-installer.scm: New file. * gnu/installer/connman.scm: New file. * gnu/installer/keymap.scm: New file. * gnu/installer/locale.scm: New file. * gnu/installer/newt.scm: New file. * gnu/installer/newt/ethernet.scm: New file. * gnu/installer/newt/hostname.scm: New file. * gnu/installer/newt/keymap.scm: New file. * gnu/installer/newt/locale.scm: New file. * gnu/installer/newt/menu.scm: New file. * gnu/installer/newt/network.scm: New file. * gnu/installer/newt/page.scm: New file. * gnu/installer/newt/timezone.scm: New file. * gnu/installer/newt/user.scm: New file. * gnu/installer/newt/utils.scm: New file. * gnu/installer/newt/welcome.scm: New file. * gnu/installer/newt/wifi.scm: New file. * gnu/installer/steps.scm: New file. * gnu/installer/timezone.scm: New file. * gnu/installer/utils.scm: New file. * gnu/local.mk (GNU_SYSTEM_MODULES): Add previous files. * gnu/system.scm: Export %root-account. * gnu/system/install.scm (%installation-services): Use kmscon instead of linux VT for all tty. (installation-os)[users]: Add the graphical installer as shell of the root account. [packages]: Add font related packages. * po/guix/POTFILES.in: Add installer files. --- gnu/installer/keymap.scm | 162 +++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 162 insertions(+) create mode 100644 gnu/installer/keymap.scm (limited to 'gnu/installer/keymap.scm') diff --git a/gnu/installer/keymap.scm b/gnu/installer/keymap.scm new file mode 100644 index 00000000000..78065aa6c62 --- /dev/null +++ b/gnu/installer/keymap.scm @@ -0,0 +1,162 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2018 Mathieu Othacehe +;;; +;;; This file is part of GNU Guix. +;;; +;;; GNU Guix is free software; you can redistribute it and/or modify it +;;; under the terms of the GNU General Public License as published by +;;; the Free Software Foundation; either version 3 of the License, or (at +;;; your option) any later version. +;;; +;;; GNU Guix is distributed in the hope that it will be useful, but +;;; WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;;; GNU General Public License for more details. +;;; +;;; You should have received a copy of the GNU General Public License +;;; along with GNU Guix. If not, see . + +(define-module (gnu installer keymap) + #:use-module (guix records) + #:use-module (sxml match) + #:use-module (sxml simple) + #:use-module (ice-9 binary-ports) + #:use-module (ice-9 ftw) + #:use-module (ice-9 match) + #:use-module (ice-9 regex) + #:export ( + x11-keymap-model + make-x11-keymap-model + x11-keymap-model? + x11-keymap-model-name + x11-keymap-model-description + + + x11-keymap-layout + make-x11-keymap-layout + x11-keymap-layout? + x11-keymap-layout-name + x11-keymap-layout-description + x11-keymap-layout-variants + + + x11-keymap-variant + make-x11-keymap-variant + x11-keymap-variant? + x11-keymap-variant-name + x11-keymap-variant-description + + xkb-rules->models+layouts + kmscon-update-keymap)) + +(define-record-type* + x11-keymap-model make-x11-keymap-model + x11-keymap-model? + (name x11-keymap-model-name) ;string + (description x11-keymap-model-description)) ;string + +(define-record-type* + x11-keymap-layout make-x11-keymap-layout + x11-keymap-layout? + (name x11-keymap-layout-name) ;string + (description x11-keymap-layout-description) ;string + (variants x11-keymap-layout-variants)) ;list of + +(define-record-type* + x11-keymap-variant make-x11-keymap-variant + x11-keymap-variant? + (name x11-keymap-variant-name) ;string + (description x11-keymap-variant-description)) ;string + +(define (xkb-rules->models+layouts file) + "Parse FILE and return two values, the list of supported X11-KEYMAP-MODEL +and X11-KEYMAP-LAYOUT records. FILE is an XML file from the X Keyboard +Configuration Database, describing possible XKB configurations." + (define (model m) + (sxml-match m + [(model + (configItem + (name ,name) + (description ,description) + . ,rest)) + (x11-keymap-model + (name name) + (description description))])) + + (define (variant v) + (sxml-match v + [(variant + ;; According to xbd-rules DTD, the definition of a + ;; configItem is: + ;; + ;; shortDescription and description are optional elements + ;; but sxml-match does not support default values for + ;; elements (only attributes). So to avoid writing as many + ;; patterns as existing possibilities, gather all the + ;; remaining elements but name in REST-VARIANT. + (configItem + (name ,name) + . ,rest-variant)) + (x11-keymap-variant + (name name) + (description (car + (assoc-ref rest-variant 'description))))])) + + (define (layout l) + (sxml-match l + [(layout + (configItem + (name ,name) + . ,rest-layout) + (variantList ,[variant -> v] ...)) + (x11-keymap-layout + (name name) + (description (car + (assoc-ref rest-layout 'description))) + (variants (list v ...)))] + [(layout + (configItem + (name ,name) + . ,rest-layout)) + (x11-keymap-layout + (name name) + (description (car + (assoc-ref rest-layout 'description))) + (variants '()))])) + + (let ((sxml (call-with-input-file file + (lambda (port) + (xml->sxml port #:trim-whitespace? #t))))) + (match + (sxml-match sxml + [(*TOP* + ,pi + (xkbConfigRegistry + (@ . ,ignored) + (modelList ,[model -> m] ...) + (layoutList ,[layout -> l] ...) + . ,rest)) + (list + (list m ...) + (list l ...))]) + ((models layouts) + (values models layouts))))) + +(define (kmscon-update-keymap model layout variant) + (let ((keymap-file (getenv "KEYMAP_UPDATE"))) + (unless (and keymap-file + (file-exists? keymap-file)) + (error "Unable to locate keymap update file")) + + (call-with-output-file keymap-file + (lambda (port) + (format port model) + (put-u8 port 0) + + (format port layout) + (put-u8 port 0) + + (format port variant) + (put-u8 port 0))))) -- cgit v1.3 From c088b2e47f6675199f1ef545df7d04d4532e64e3 Mon Sep 17 00:00:00 2001 From: Mathieu Othacehe Date: Wed, 5 Dec 2018 14:36:22 +0900 Subject: installer: Do not ask for keyboard model. Suppose that the keyboard model is "pc105". * gnu/installer.scm (apply-keymap): Remove model ... * gnu/installer/newt/keymap.scm (run-keymap-page): passed here. (run-model-page): remove procedure * gnu/installer/record.scm (installer): Edit keymap-page prototype in comment. * gnu/installer/keymap.scm (default-keyboard-model): New exported parameter. --- gnu/installer.scm | 10 +++++----- gnu/installer/keymap.scm | 4 ++++ gnu/installer/newt.scm | 5 ++--- gnu/installer/newt/keymap.scm | 44 ++++++------------------------------------- gnu/installer/newt/locale.scm | 6 +++--- gnu/installer/record.scm | 2 +- 6 files changed, 21 insertions(+), 50 deletions(-) (limited to 'gnu/installer/keymap.scm') diff --git a/gnu/installer.scm b/gnu/installer.scm index e53acb12f4a..4a587eb35be 100644 --- a/gnu/installer.scm +++ b/gnu/installer.scm @@ -133,10 +133,11 @@ been performed at build time." result)))) (define apply-keymap - ;; Apply the specified keymap. + ;; Apply the specified keymap. Use the default keyboard model. #~(match-lambda - ((model layout variant) - (kmscon-update-keymap model layout variant)))) + ((layout variant) + (kmscon-update-keymap (default-keyboard-model) + layout variant)))) (define* (compute-keymap-step) "Return a gexp that runs the keymap-page of INSTALLER and install the @@ -150,8 +151,7 @@ selected keymap." "/share/X11/xkb/rules/base.xml"))) (lambda (models layouts) ((installer-keymap-page current-installer) - #:models models - #:layouts layouts))))) + layouts))))) (#$apply-keymap result)))) (define (installer-steps) diff --git a/gnu/installer/keymap.scm b/gnu/installer/keymap.scm index 78065aa6c62..d9f8656855d 100644 --- a/gnu/installer/keymap.scm +++ b/gnu/installer/keymap.scm @@ -46,6 +46,7 @@ x11-keymap-variant-name x11-keymap-variant-description + default-keyboard-model xkb-rules->models+layouts kmscon-update-keymap)) @@ -68,6 +69,9 @@ (name x11-keymap-variant-name) ;string (description x11-keymap-variant-description)) ;string +;; Assume all modern keyboards have this model. +(define default-keyboard-model (make-parameter "pc105")) + (define (xkb-rules->models+layouts file) "Parse FILE and return two values, the list of supported X11-KEYMAP-MODEL and X11-KEYMAP-LAYOUT records. FILE is an XML file from the X Keyboard diff --git a/gnu/installer/newt.scm b/gnu/installer/newt.scm index 77a7e6dca2e..1f51b111a89 100644 --- a/gnu/installer/newt.scm +++ b/gnu/installer/newt.scm @@ -68,9 +68,8 @@ (define (menu-page steps) (run-menu-page steps)) -(define* (keymap-page #:key models layouts) - (run-keymap-page #:models models - #:layouts layouts)) +(define* (keymap-page layouts) + (run-keymap-page layouts)) (define (network-page) (run-network-page)) diff --git a/gnu/installer/newt/keymap.scm b/gnu/installer/newt/keymap.scm index 0c9432bba2a..0c38a79e198 100644 --- a/gnu/installer/newt/keymap.scm +++ b/gnu/installer/newt/keymap.scm @@ -56,42 +56,12 @@ (condition (&installer-step-abort))))))) -(define (run-model-page models model->text) - (let ((title (G_ "Keyboard model selection"))) - (run-listbox-selection-page - #:title title - #:info-text (G_ "Please choose your keyboard model.") - #:listbox-items models - #:listbox-item->text model->text - #:listbox-default-item (find (lambda (model) - (string=? (x11-keymap-model-name model) - "pc105")) - models) - #:sort-listbox-items? #f - #:button-text (G_ "Back") - #:button-callback-procedure - (lambda _ - (raise - (condition - (&installer-step-abort))))))) - -(define* (run-keymap-page #:key models layouts) - "Run a page asking the user to select a keyboard model, layout and -variant. MODELS and LAYOUTS are lists of supported X11-KEYMAP-MODEL and -X11-KEYMAP-LAYOUT. Return a list of three elements, the names of the selected -keyboard model, layout and variant." +(define* (run-keymap-page layouts) + "Run a page asking the user to select a keyboard layout and variant. LAYOUTS +is a list of supported X11-KEYMAP-LAYOUT. Return a list of two elements, the +names of the selected keyboard layout and variant." (define keymap-steps (list - (installer-step - (id 'model) - (compute - (lambda _ - ;; TODO: Understand why (run-model-page models x11-keymap-model-name) - ;; fails with: warning: possibly unbound variable - ;; `%x11-keymap-model-description-procedure. - (run-model-page models (lambda (model) - (x11-keymap-model-description - model)))))) (installer-step (id 'layout) (compute @@ -120,13 +90,11 @@ keyboard model, layout and variant." variant))))))))) (define (format-result result) - (let ((model (x11-keymap-model-name - (result-step result 'model))) - (layout (x11-keymap-layout-name + (let ((layout (x11-keymap-layout-name (result-step result 'layout))) (variant (and=> (result-step result 'variant) (lambda (variant) (x11-keymap-variant-name variant))))) - (list model layout (or variant "")))) + (list layout (or variant "")))) (format-result (run-installer-steps #:steps keymap-steps))) diff --git a/gnu/installer/newt/locale.scm b/gnu/installer/newt/locale.scm index 599a6b0ecfa..028372c1941 100644 --- a/gnu/installer/newt/locale.scm +++ b/gnu/installer/newt/locale.scm @@ -143,7 +143,7 @@ glibc locale string and return it." (installer-step (id 'territory) (compute - (lambda (result) + (lambda (result _) (let ((locales (filter-locales supported-locales result))) ;; Stop the process if the language returned by the previous step ;; is matching one and only one supported locale. @@ -161,7 +161,7 @@ glibc locale string and return it." (installer-step (id 'codeset) (compute - (lambda (result) + (lambda (result _) (let ((locales (filter-locales supported-locales result))) ;; Same as above but we now have a language and a territory to ;; narrow down the search of a locale. @@ -173,7 +173,7 @@ glibc locale string and return it." (installer-step (id 'modifier) (compute - (lambda (result) + (lambda (result _) (let ((locales (filter-locales supported-locales result))) ;; Same thing with a language, a territory and a codeset this time. (break-on-locale-found locales) diff --git a/gnu/installer/record.scm b/gnu/installer/record.scm index bf740406996..ba7625e65a5 100644 --- a/gnu/installer/record.scm +++ b/gnu/installer/record.scm @@ -57,9 +57,9 @@ (exit installer-exit) ;; procedure (key arguments) -> void (exit-error installer-exit-error) - ;; procedure (#:key models layouts) -> (list model layout variant) ;; procedure void -> void (final-page installer-final-page) + ;; procedure (layouts) -> (list layout variant) (keymap-page installer-keymap-page) ;; procedure: (#:key supported-locales iso639-languages iso3166-territories) ;; -> glibc-locale -- cgit v1.3 From 479414e1c9e13ddce9e0c8741eb9f50dff62e333 Mon Sep 17 00:00:00 2001 From: Mathieu Othacehe Date: Wed, 5 Dec 2018 21:53:40 +0900 Subject: installer: keymap: Do not fail on non-kmscon terminals. kmscon-update-keymap fails on non kmscon terminals because KEYMAP_UPDATE environment variable is not defined. As it is convenient to test the installer on a regular terminal, do nothing if KEYMAP_UPDATE is missing. * gnu/installer/keymap.scm (kmscon-update-keymap): Do nothing if KEYMAP_UPDATE is not defined. --- gnu/installer/keymap.scm | 36 +++++++++++++++++++++--------------- 1 file changed, 21 insertions(+), 15 deletions(-) (limited to 'gnu/installer/keymap.scm') diff --git a/gnu/installer/keymap.scm b/gnu/installer/keymap.scm index d9f8656855d..d66b376d9ca 100644 --- a/gnu/installer/keymap.scm +++ b/gnu/installer/keymap.scm @@ -149,18 +149,24 @@ Configuration Database, describing possible XKB configurations." (values models layouts))))) (define (kmscon-update-keymap model layout variant) - (let ((keymap-file (getenv "KEYMAP_UPDATE"))) - (unless (and keymap-file - (file-exists? keymap-file)) - (error "Unable to locate keymap update file")) - - (call-with-output-file keymap-file - (lambda (port) - (format port model) - (put-u8 port 0) - - (format port layout) - (put-u8 port 0) - - (format port variant) - (put-u8 port 0))))) + "Update kmscon keymap with the provided MODEL, LAYOUT and VARIANT." + (and=> + (getenv "KEYMAP_UPDATE") + (lambda (keymap-file) + (unless (file-exists? keymap-file) + (error "Unable to locate keymap update file")) + + ;; See file gnu/packages/patches/kmscon-runtime-keymap-switch.patch. + ;; This dirty hack makes possible to update kmscon keymap at runtime by + ;; writing an X11 keyboard model, layout and variant to a named pipe + ;; referred by KEYMAP_UPDATE environment variable. + (call-with-output-file keymap-file + (lambda (port) + (format port model) + (put-u8 port 0) + + (format port layout) + (put-u8 port 0) + + (format port variant) + (put-u8 port 0)))))) -- cgit v1.3