summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2020-01-20 14:34:16 +0100
committerLudovic Courtès <ludo@gnu.org>2020-01-20 23:20:59 +0100
commit48659aa22170a252c9b2e60f16fbe9f83a6deba4 (patch)
tree6637d39a01bce6c66c3df66dc4e0b42eefd1d96e
parent25623647e9c6f5cafea902ac3d8d6d7ac03c0b3c (diff)
downloadpatches-48659aa22170a252c9b2e60f16fbe9f83a6deba4.tar
patches-48659aa22170a252c9b2e60f16fbe9f83a6deba4.tar.gz
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'.
-rw-r--r--gnu/installer/newt/page.scm101
1 files changed, 52 insertions, 49 deletions
diff --git a/gnu/installer/newt/page.scm b/gnu/installer/newt/page.scm
index bff5fae4e6..ef2d8368fb 100644
--- a/gnu/installer/newt/page.scm
+++ b/gnu/installer/newt/page.scm
@@ -566,35 +566,38 @@ ITEMS when 'Ok' is pressed."
(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 @@ ITEMS when 'Ok' is pressed."
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)))))