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.
This commit is contained in:
		
							parent
							
								
									dc5f3275ec
								
							
						
					
					
						commit
						c088b2e47f
					
				
					 6 changed files with 21 additions and 50 deletions
				
			
		|  | @ -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) | ||||
|  |  | |||
|  | @ -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 | ||||
|  |  | |||
|  | @ -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)) | ||||
|  |  | |||
|  | @ -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))) | ||||
|  |  | |||
|  | @ -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) | ||||
|  |  | |||
|  | @ -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 | ||||
|  |  | |||
		Reference in a new issue