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 ;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2018 Mathieu Othacehe <m.othacehe@gmail.com> ;;; 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. ;;; 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)) (string-drop file (string-length prefix))
file)) file))
(define (run-config-display-page) (define* (run-config-display-page #:key locale)
(let ((width (%configuration-file-width)) (let ((width (%configuration-file-width))
(height (nearest-exact-integer (height (nearest-exact-integer
(/ (screen-rows) 2)))) (/ (screen-rows) 2))))
@ -50,6 +50,8 @@ (define (run-config-display-page)
(strip-prefix (%installer-configuration-file))) (strip-prefix (%installer-configuration-file)))
#:title (G_ "Configuration file") #:title (G_ "Configuration file")
#:file (%installer-configuration-file) #:file (%installer-configuration-file)
#:edit-button? #t
#:editor-locale locale
#:info-textbox-width width #:info-textbox-width width
#:file-textbox-width width #:file-textbox-width width
#:file-textbox-height height #:file-textbox-height height
@ -95,7 +97,7 @@ (define (run-final-page result prev-steps)
(with-mounted-partitions (with-mounted-partitions
user-partitions user-partitions
(configuration->file configuration) (configuration->file configuration)
(run-config-display-page) (run-config-display-page #:locale locale)
(run-install-shell locale #:users users)))) (run-install-shell locale #:users users))))
(if install-ok? (if install-ok?
(run-install-success-page) (run-install-success-page)

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

@ -1,6 +1,6 @@
;;; GNU Guix --- Functional package management for GNU ;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2018 Mathieu Othacehe <m.othacehe@gmail.com> ;;; 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> ;;; Copyright © 2019 Tobias Geerinckx-Rice <me@tobias.gr>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
@ -541,6 +541,17 @@ (define (fill-checkbox-tree checkbox-tree items)
(lambda () (lambda ()
(destroy-form-and-pop form)))))) (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 (define* (run-file-textbox-page #:key
info-text info-text
title title
@ -549,6 +560,8 @@ (define* (run-file-textbox-page #:key
(file-textbox-width 50) (file-textbox-width 50)
(file-textbox-height 30) (file-textbox-height 30)
(exit-button? #t) (exit-button? #t)
(edit-button? #f)
(editor-locale #f)
(ok-button-callback-procedure (ok-button-callback-procedure
(const #t)) (const #t))
(exit-button-callback-procedure (exit-button-callback-procedure
@ -557,7 +570,6 @@ (define* (run-file-textbox-page #:key
(make-reflowed-textbox -1 -1 info-text (make-reflowed-textbox -1 -1 info-text
info-textbox-width info-textbox-width
#:flags FLAG-BORDER)) #:flags FLAG-BORDER))
(file-text (read-all file))
(file-textbox (file-textbox
(make-textbox -1 -1 (make-textbox -1 -1
file-textbox-width file-textbox-width
@ -565,6 +577,8 @@ (define* (run-file-textbox-page #:key
(logior FLAG-SCROLL FLAG-BORDER))) (logior FLAG-SCROLL FLAG-BORDER)))
(ok-button (make-button -1 -1 (G_ "OK"))) (ok-button (make-button -1 -1 (G_ "OK")))
(exit-button (make-button -1 -1 (G_ "Exit"))) (exit-button (make-button -1 -1 (G_ "Exit")))
(edit-button (and edit-button?
(make-button -1 -1 (G_ "Edit"))))
(grid (vertically-stacked-grid (grid (vertically-stacked-grid
GRID-ELEMENT-COMPONENT info-textbox GRID-ELEMENT-COMPONENT info-textbox
GRID-ELEMENT-COMPONENT file-textbox GRID-ELEMENT-COMPONENT file-textbox
@ -572,32 +586,42 @@ (define* (run-file-textbox-page #:key
(apply (apply
horizontal-stacked-grid horizontal-stacked-grid
GRID-ELEMENT-COMPONENT ok-button 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) (list GRID-ELEMENT-COMPONENT exit-button)
'()))))) '())))))
(form (make-form))) (form (make-form)))
(set-textbox-text file-textbox (let loop ()
(receive (_w _h text) (set-textbox-text file-textbox
(reflow-text file-text (receive (_w _h text)
file-textbox-width (reflow-text (read-all file)
0 0) file-textbox-width
text)) 0 0)
(add-form-to-grid grid form #t) text))
(make-wrapped-grid-window grid title)
(receive (exit-reason argument) (add-form-to-grid grid form #t)
(run-form form) (make-wrapped-grid-window grid title)
(dynamic-wind
(const #t) (receive (exit-reason argument)
(lambda () (run-form form)
(case exit-reason (dynamic-wind
((exit-component) (const #t)
(cond (lambda ()
((components=? argument ok-button) (case exit-reason
(ok-button-callback-procedure)) ((exit-component)
((and exit-button? (cond
(components=? argument exit-button)) ((components=? argument ok-button)
(exit-button-callback-procedure)))))) (ok-button-callback-procedure))
(lambda () ((and exit-button?
(destroy-form-and-pop form)))))) (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))))))))