;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2018, 2020 Mathieu Othacehe ;;; Copyright © 2019 Ludovic Courtès ;;; Copyright © 2020 Florian Pelz ;;; ;;; 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 newt keymap) #:use-module (gnu installer keymap) #:use-module (gnu installer steps) #:use-module (gnu installer newt page) #:use-module (guix i18n) #:use-module (guix records) #:use-module (newt) #:use-module (srfi srfi-1) #:use-module (srfi srfi-26) #:use-module (srfi srfi-34) #:use-module (srfi srfi-35) #:use-module (ice-9 i18n) #:use-module (ice-9 match) #:export (run-keymap-page keyboard-layout->configuration)) (define (run-layout-page layouts layout->text context) (let ((title (G_ "Layout"))) (run-listbox-selection-page #:title title #:info-text (case context ((param) (G_ "Please choose your keyboard layout. \ It will only be used during the installation process. \ Non-Latin layouts can be toggled with Alt+Shift.")) (else (G_ "Please choose your keyboard layout. \ It will be used during the install process, and for the installed system. \ Non-Latin layouts can be toggled with Alt+Shift. You can switch to a \ different layout at any time from the parameters menu."))) #:listbox-items layouts #:listbox-item->text layout->text #:sort-listbox-items? #f #:button-text (case context ((param) (G_ "Continue")) (else (G_ "Exit"))) #:button-callback-procedure (case context ((param) (const #f)) (else (lambda _ (abort-to-prompt 'installer-step 'abort))))))) (define (run-variant-page variants variant->text) (let ((title (G_ "Variant"))) (run-listbox-selection-page #:title title #:info-text (G_ "Please choose a variant for your keyboard layout.") #:listbox-items variants #:listbox-item->text variant->text #:sort-listbox-items? #f #:button-text (G_ "Back") #:button-callback-procedure (lambda _ (abort-to-prompt 'installer-step 'abort))))) (define (sort-layouts layouts) "Sort LAYOUTS list by putting the US layout ahead and return it." (define (layout <>))) (define %non-latin-layouts ;; List of keyboard layouts marked as $nonlatin in xkeyboard-config. ;; See comments in xkeyboard-config file /share/X11/xkb/rules/base. ;; We ignore layouts that support Latin input: "kr" '("am" "ara" "ben" "bd" "bg" "bt" "by" "cs" "deva" "ge" "gh" "gr" "guj" "guru" "il" "in" "ir" "iku" "jp" "kan" "kh" "la" "lao" "lk" "mk" "mm" "mn" "mv" "mal" "olck" "ori" "pk" "ru" "scc" "sy" "syr" "tel" "th" "tj" "tam" "ua" "uz" ;; The list from xkeyboard-config is incomplete. Add more layouts when ;; noticed: "et" "kz")) (define %non-latin-variants '("cyrillic")) (define %latin-layout+variants ;; These layout+variant combinations are Latin after all. '(("ir" "ku"))) (define (toggleable-latin-layout layout variant) "If LAYOUT is a non-Latin layout, return a new combined layout, a variant, and options that allow the user to switch between the non-Latin and the Latin layout. Otherwise, return LAYOUT, VARIANT, and #f." (if (and (not (equal? variant "latin")) (not (member (list layout variant) %latin-layout+variants)) (or (member layout %non-latin-layouts) (member variant %non-latin-variants))) (let ((latin-layout (if (equal? variant "azerty") "fr" "us"))) (list (string-append layout "," latin-layout) ;; Comma to use variant only for non-Latin: (and variant (string-append variant ",")) "grp:alt_shift_toggle")) (list layout variant #f))) (define* (run-keymap-page layouts #:key (context #f)) "Run a page asking the user to select a keyboard layout and variant. LAYOUTS is a list of supported X11-KEYMAP-LAYOUT. For non-Latin keyboard layouts, a second layout and toggle options will be added automatically. Return a list of three elements, the names of the selected keyboard layout, variant and options." (define keymap-steps (list (installer-step (id 'layout) (compute (lambda _ (run-layout-page (sort-layouts layouts) (lambda (layout) (gettext (x11-keymap-layout-description layout) "xkeyboard-config")) context)))) ;; Propose the user to select a variant among those supported by t2015-09-06gnu: calibre: Update to 2.37.1....Andreas Enge ants layout) '()))) ;; Return #f if the layout does not have any variant. (and (not (null? variants)) (run-variant-page (sort-variants (add-empty-variant variants)) (lambda (variant) (if variant (gettext (x11-keymap-variant-description variant) "xkeyboard-config") ;; Text to opt for no variant at all: (gettext (x11-keymap-layout-description layout) "xkeyboard-config"))))))))))) (define (format-result layout variant) (let ((layout (x11-keymap-layout-name layout)) (variant (and=> variant (lambda (variant) (gettext (x11-keymap-variant-name variant) "xkeyboard-config"))))) (toggleable-latin-layout layout variant))) (let* ((result (run-installer-steps #:steps keymap-steps)) (layout (result-step result 'layout)) (variant (result-step result 'variant))) (and layout (format-result layout variant)))) (define (keyboard-layout->configuration keymap) "Return the operating system configuration snippet to install KEYMAP." (match keymap ((name #f "grp:alt_shift_toggle") `((keyboard-layout (keyboard-layout ,name #:options '("grp:alt_shift_toggle"))))) ((name #f _) `((keyboard-layout (keyboard-layout ,name)))) ((name variant "grp:alt_shift_toggle") `((keyboard-layout (keyboard-layout ,name ,variant #:options '("grp:alt_shift_toggle"))))) ((name variant _) `((keyboard-layout (keyboard-layout ,name ,variant))))))