You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
 
 
 
 
 
 

133 lines
4.8 KiB

  1. ;;; GNU Guix --- Functional package management for GNU
  2. ;;; Copyright © 2018 Mathieu Othacehe <m.othacehe@gmail.com>
  3. ;;;
  4. ;;; This file is part of GNU Guix.
  5. ;;;
  6. ;;; GNU Guix is free software; you can redistribute it and/or modify it
  7. ;;; under the terms of the GNU General Public License as published by
  8. ;;; the Free Software Foundation; either version 3 of the License, or (at
  9. ;;; your option) any later version.
  10. ;;;
  11. ;;; GNU Guix is distributed in the hope that it will be useful, but
  12. ;;; WITHOUT ANY WARRANTY; without even the implied warranty of
  13. ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  14. ;;; GNU General Public License for more details.
  15. ;;;
  16. ;;; You should have received a copy of the GNU General Public License
  17. ;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
  18. (define-module (gnu installer newt keymap)
  19. #:use-module (gnu installer keymap)
  20. #:use-module (gnu installer steps)
  21. #:use-module (gnu installer newt page)
  22. #:use-module (guix i18n)
  23. #:use-module (guix records)
  24. #:use-module (newt)
  25. #:use-module (srfi srfi-1)
  26. #:use-module (srfi srfi-34)
  27. #:use-module (srfi srfi-35)
  28. #:export (run-keymap-page))
  29. (define (run-layout-page layouts layout->text)
  30. (let ((title (G_ "Layout selection")))
  31. (run-listbox-selection-page
  32. #:title title
  33. #:info-text (G_ "Please choose your keyboard layout.")
  34. #:listbox-items layouts
  35. #:listbox-item->text layout->text
  36. #:button-text (G_ "Cancel")
  37. #:button-callback-procedure
  38. (lambda _
  39. (raise
  40. (condition
  41. (&installer-step-abort)))))))
  42. (define (run-variant-page variants variant->text)
  43. (let ((title (G_ "Variant selection")))
  44. (run-listbox-selection-page
  45. #:title title
  46. #:info-text (G_ "Please choose a variant for your keyboard layout.")
  47. #:listbox-items variants
  48. #:listbox-item->text variant->text
  49. #:button-text (G_ "Back")
  50. #:button-callback-procedure
  51. (lambda _
  52. (raise
  53. (condition
  54. (&installer-step-abort)))))))
  55. (define (run-model-page models model->text)
  56. (let ((title (G_ "Keyboard model selection")))
  57. (run-listbox-selection-page
  58. #:title title
  59. #:info-text (G_ "Please choose your keyboard model.")
  60. #:listbox-items models
  61. #:listbox-item->text model->text
  62. #:listbox-default-item (find (lambda (model)
  63. (string=? (x11-keymap-model-name model)
  64. "pc105"))
  65. models)
  66. #:sort-listbox-items? #f
  67. #:button-text (G_ "Back")
  68. #:button-callback-procedure
  69. (lambda _
  70. (raise
  71. (condition
  72. (&installer-step-abort)))))))
  73. (define* (run-keymap-page #:key models layouts)
  74. "Run a page asking the user to select a keyboard model, layout and
  75. variant. MODELS and LAYOUTS are lists of supported X11-KEYMAP-MODEL and
  76. X11-KEYMAP-LAYOUT. Return a list of three elements, the names of the selected
  77. keyboard model, layout and variant."
  78. (define keymap-steps
  79. (list
  80. (installer-step
  81. (id 'model)
  82. (compute
  83. (lambda _
  84. ;; TODO: Understand why (run-model-page models x11-keymap-model-name)
  85. ;; fails with: warning: possibly unbound variable
  86. ;; `%x11-keymap-model-description-procedure.
  87. (run-model-page models (lambda (model)
  88. (x11-keymap-model-description
  89. model))))))
  90. (installer-step
  91. (id 'layout)
  92. (compute
  93. (lambda _
  94. (let* ((layout (run-layout-page
  95. layouts
  96. (lambda (layout)
  97. (x11-keymap-layout-description layout)))))
  98. (if (null? (x11-keymap-layout-variants layout))
  99. ;; Break if this layout does not have any variant.
  100. (raise
  101. (condition
  102. (&installer-step-break)))
  103. layout)))))
  104. ;; Propose the user to select a variant among those supported by the
  105. ;; previously selected layout.
  106. (installer-step
  107. (id 'variant)
  108. (compute
  109. (lambda (result)
  110. (let ((variants (x11-keymap-layout-variants
  111. (result-step result 'layout))))
  112. (run-variant-page variants
  113. (lambda (variant)
  114. (x11-keymap-variant-description
  115. variant)))))))))
  116. (define (format-result result)
  117. (let ((model (x11-keymap-model-name
  118. (result-step result 'model)))
  119. (layout (x11-keymap-layout-name
  120. (result-step result 'layout)))
  121. (variant (and=> (result-step result 'variant)
  122. (lambda (variant)
  123. (x11-keymap-variant-name variant)))))
  124. (list model layout (or variant ""))))
  125. (format-result
  126. (run-installer-steps #:steps keymap-steps)))