TakeV/guix
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity

installer: Add an "Edit" button on the final page.

Browse source 
Fixes <https://bugs.gnu.org/36885>.
Reported by <lukasbf@tutanota.com>.

* gnu/installer/newt/page.scm (edit-file): New procedure.
(run-file-textbox-page): Add #:edit-button? and #:editor-locale
parameters.  Remove 'file-text' and add 'edit-button', and add it
to the horizontal stacked grid when EXIT-BUTTON? is true.  Wrap
body in 'loop'.  Handle case where ARGUMENT is EDIT-BUTTON by calling
'loop'.
* gnu/installer/newt/final.scm (run-config-display-page): Add #:locale
parameter.  Pass #:edit-button? and #:editor-locale to
'run-file-textbox-page'.
(run-final-page): Pass LOCALE to 'run-config-display-page'.
This commit is contained in:
Ludovic Courtès 2020-01-12 21:59:01 +01:00
parent 1e44ae6fe7
commit 9ced0f376b
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5
2 changed files with 55 additions and 29 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

8
gnu/installer/newt/final.scm
View file

@ -1,6 +1,6 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2018 Mathieu Othacehe <m.othacehe@gmail.com>
;;; Copyright © 2019 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2019, 2020 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@ -36,7 +36,7 @@ (define* (strip-prefix file #:optional (prefix (%installer-target-dir)))
(string-drop file (string-length prefix))
file))
(define (run-config-display-page)
(define* (run-config-display-page #:key locale)
(let ((width (%configuration-file-width))
(height (nearest-exact-integer
(/ (screen-rows) 2))))
@ -50,6 +50,8 @@ (define (run-config-display-page)
(strip-prefix (%installer-configuration-file)))
#:title (G_ "Configuration file")
#:file (%installer-configuration-file)
#:edit-button? #t
#:editor-locale locale
#:info-textbox-width width
#:file-textbox-width width
#:file-textbox-height height
@ -95,7 +97,7 @@ (define (run-final-page result prev-steps)
(with-mounted-partitions
user-partitions
(configuration->file configuration)
(run-config-display-page)
(run-config-display-page #:locale locale)
(run-install-shell locale #:users users))))
(if install-ok?
(run-install-success-page)

76
gnu/installer/newt/page.scm
View file

@ -1,6 +1,6 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2018 Mathieu Othacehe <m.othacehe@gmail.com>
;;; Copyright © 2019 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2019, 2020 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2019 Tobias Geerinckx-Rice <me@tobias.gr>
;;;
;;; This file is part of GNU Guix.
@ -541,6 +541,17 @@ (define (fill-checkbox-tree checkbox-tree items)
(lambda ()
(destroy-form-and-pop form))))))
(define* (edit-file file #:key locale)
"Spawn an editor for FILE."
(clear-screen)
(newt-suspend)
;; Use Nano because it syntax-highlights Scheme by default.
;; TODO: Add a menu to choose an editor?
(run-shell-command (string-append "/run/current-system/profile/bin/nano "
file)
#:locale locale)
(newt-resume))
(define* (run-file-textbox-page #:key
info-text
title
@ -549,6 +560,8 @@ (define* (run-file-textbox-page #:key
(file-textbox-width 50)
(file-textbox-height 30)
(exit-button? #t)
(edit-button? #f)
(editor-locale #f)
(ok-button-callback-procedure
(const #t))
(exit-button-callback-procedure
@ -557,7 +570,6 @@ (define* (run-file-textbox-page #:key
(make-reflowed-textbox -1 -1 info-text
info-textbox-width
#:flags FLAG-BORDER))
(file-text (read-all file))
(file-textbox
(make-textbox -1 -1
file-textbox-width
@ -565,6 +577,8 @@ (define* (run-file-textbox-page #:key
(logior FLAG-SCROLL FLAG-BORDER)))
(ok-button (make-button -1 -1 (G_ "OK")))
(exit-button (make-button -1 -1 (G_ "Exit")))
(edit-button (and edit-button?
(make-button -1 -1 (G_ "Edit"))))
(grid (vertically-stacked-grid
GRID-ELEMENT-COMPONENT info-textbox
GRID-ELEMENT-COMPONENT file-textbox
@ -572,32 +586,42 @@ (define* (run-file-textbox-page #:key
(apply
horizontal-stacked-grid
GRID-ELEMENT-COMPONENT ok-button
`(,@(if exit-button?
`(,@(if edit-button?
(list GRID-ELEMENT-COMPONENT edit-button)
'())
,@(if exit-button?
(list GRID-ELEMENT-COMPONENT exit-button)
'())))))
(form (make-form)))
(set-textbox-text file-textbox
(receive (_w _h text)
(reflow-text file-text
file-textbox-width
0 0)
text))
(add-form-to-grid grid form #t)
(make-wrapped-grid-window grid title)
(let loop ()
(set-textbox-text file-textbox
(receive (_w _h text)
(reflow-text (read-all file)
file-textbox-width
0 0)
text))
(receive (exit-reason argument)
(run-form form)
(dynamic-wind
(const #t)
(lambda ()
(case exit-reason
((exit-component)
(cond
((components=? argument ok-button)
(ok-button-callback-procedure))
((and exit-button?
(components=? argument exit-button))
(exit-button-callback-procedure))))))
(lambda ()
(destroy-form-and-pop form))))))
(add-form-to-grid grid form #t)
(make-wrapped-grid-window grid title)
(receive (exit-reason argument)
(run-form form)
(dynamic-wind
(const #t)
(lambda ()
(case exit-reason
((exit-component)
(cond
((components=? argument ok-button)
(ok-button-callback-procedure))
((and exit-button?
(components=? argument exit-button))
(exit-button-callback-procedure))
((and edit-button?
(components=? argument edit-button))
(edit-file file))))))
(lambda ()
(if (components=? argument edit-button)
(loop)
(destroy-form-and-pop form))))))))