summaryrefslogtreecommitdiff
path: root/gnu/installer/newt
diff options
context:
space:
mode:
Diffstat (limited to 'gnu/installer/newt')
-rw-r--r--gnu/installer/newt/final.scm8
-rw-r--r--gnu/installer/newt/page.scm133
2 files changed, 85 insertions, 56 deletions
diff --git a/gnu/installer/newt/final.scm b/gnu/installer/newt/final.scm
index e375282613..061bcd3f78 100644
--- a/gnu/installer/newt/final.scm
+++ b/gnu/installer/newt/final.scm
@@ -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 @@
(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 @@ This will take a few minutes.")
(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 @@ last step, or restart the installer.")))
(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)
diff --git a/gnu/installer/newt/page.scm b/gnu/installer/newt/page.scm
index 630efde9cc..8aea5a1109 100644
--- a/gnu/installer/newt/page.scm
+++ b/gnu/installer/newt/page.scm
@@ -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.
@@ -107,7 +107,7 @@ input box, such as FLAG-PASSWORD."
(list GRID-ELEMENT-COMPONENT input-visible-cb)
'())))
GRID-ELEMENT-COMPONENT ok-button))
- (form (make-form)))
+ (form (make-form #:flags FLAG-NOF12)))
(add-component-callback
input-visible-cb
@@ -181,7 +181,7 @@ of the page is set to TITLE."
(horizontal-stacked-grid
GRID-ELEMENT-COMPONENT ok-button
GRID-ELEMENT-COMPONENT exit-button)))
- (form (make-form)))
+ (form (make-form #:flags FLAG-NOF12)))
(add-form-to-grid grid form #t)
(make-wrapped-grid-window grid title)
@@ -315,7 +315,7 @@ the current listbox item has to be selected by key."
(if listbox-allow-multiple?
FLAG-MULTIPLE
0))))
- (form (make-form))
+ (form (make-form #:flags FLAG-NOF12))
(info-textbox
(make-reflowed-textbox -1 -1 info-text
info-textbox-width
@@ -516,7 +516,7 @@ ITEMS when 'Ok' is pressed."
GRID-ELEMENT-COMPONENT ok-button
GRID-ELEMENT-COMPONENT exit-button)))
(keys (fill-checkbox-tree checkbox-tree items))
- (form (make-form)))
+ (form (make-form #:flags FLAG-NOF12)))
(add-form-to-grid grid form #t)
(make-wrapped-grid-window grid title)
@@ -541,6 +541,17 @@ ITEMS when 'Ok' is pressed."
(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,55 +560,71 @@ ITEMS when 'Ok' is pressed."
(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
(const #t)))
- (let* ((info-textbox
- (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
- file-textbox-height
- (logior FLAG-SCROLL FLAG-BORDER)))
- (ok-button (make-button -1 -1 (G_ "OK")))
- (exit-button (make-button -1 -1 (G_ "Exit")))
- (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 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)
-
- (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))))))
+ (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 #:flags FLAG-NOF12)))
+
+ (add-form-to-grid grid form #t)
+ (make-wrapped-grid-window grid title)
+
+ (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)
+ (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)))))
generated by cgit v1.2.3 (git 2.25.4) at 2024-07-07 02:38:04 +0000