diff options
| -rw-r--r-- | gnu/installer/newt/page.scm | 101 |
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))))) |