installer: Makes sure the installer proceeds after hitting "Edit".

Fixes <https://bugs.gnu.org/39199>.
Reported by Jonathan Brielmaier <jonathan.brielmaier@web.de>.

* gnu/installer/newt/page.scm (run-file-textbox-page): Move 'loop' to
the beginning of the body.  Do not call 'loop' from the 'dynamic-wind'
exit handler as we would not return the value of the second call to
'loop'.
This commit is contained in:
Ludovic Courtès 2020-01-20 14:34:16 +01:00
parent 25623647e9
commit 48659aa221
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5

View file

@ -566,35 +566,38 @@ (define* (run-file-textbox-page #:key
(const #t))
(exit-button-callback-procedure
(const #t)))
(let* ((info-textbox
(make-reflowed-textbox -1 -1 info-text
info-textbox-width
#:flags FLAG-BORDER))
(file-textbox
(make-textbox -1 -1
file-textbox-width
file-textbox-height
(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
GRID-ELEMENT-SUBGRID
(apply
horizontal-stacked-grid
GRID-ELEMENT-COMPONENT ok-button
`(,@(if edit-button?
(list GRID-ELEMENT-COMPONENT edit-button)
'())
,@(if exit-button?
(list GRID-ELEMENT-COMPONENT exit-button)
'())))))
(form (make-form)))
(let loop ()
(let* ((info-textbox
(make-reflowed-textbox -1 -1 info-text
info-textbox-width
#:flags FLAG-BORDER))
(file-textbox
(make-textbox -1 -1
file-textbox-width
file-textbox-height
(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
GRID-ELEMENT-SUBGRID
(apply
horizontal-stacked-grid
GRID-ELEMENT-COMPONENT ok-button
`(,@(if edit-button?
(list GRID-ELEMENT-COMPONENT edit-button)
'())
,@(if exit-button?
(list GRID-ELEMENT-COMPONENT exit-button)
'())))))
(form (make-form)))
(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)
@ -602,26 +605,26 @@ (define* (run-file-textbox-page #:key
0 0)
text))
(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))))))))
(define result
(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 ()
(destroy-form-and-pop form))))
(if (components=? argument edit-button)
(loop) ;recurse in tail position
result)))))