diff options
author | Marius Bakke <mbakke@fastmail.com> | 2020-01-15 00:09:46 +0100 |
---|---|---|
committer | Marius Bakke <mbakke@fastmail.com> | 2020-01-15 00:09:46 +0100 |
commit | 3cfe76bec06fbd8bb7e7cb3387866fefbcad674f (patch) | |
tree | b66780d205fb50fd44d0bbb38f5df99cf3167ba1 /gnu/installer | |
parent | ec836b46bf52a5f86c61f50e3a2c3330a7ee3665 (diff) | |
parent | 574a71a7a9668aa184661c58e1f18a4d4fccd792 (diff) | |
download | guix-patches-3cfe76bec06fbd8bb7e7cb3387866fefbcad674f.tar guix-patches-3cfe76bec06fbd8bb7e7cb3387866fefbcad674f.tar.gz |
Merge branch 'master' into core-updates
Diffstat (limited to 'gnu/installer')
-rw-r--r-- | gnu/installer/newt/final.scm | 8 | ||||
-rw-r--r-- | gnu/installer/newt/page.scm | 78 |
2 files changed, 56 insertions, 30 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..bff5fae4e6 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. @@ -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,6 +560,8 @@ 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 @@ -557,7 +570,6 @@ ITEMS when 'Ok' is pressed." (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 @@ -565,6 +577,8 @@ ITEMS when 'Ok' is pressed." (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 @@ -572,32 +586,42 @@ ITEMS when 'Ok' is pressed." (apply horizontal-stacked-grid 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) '()))))) (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 () + (set-textbox-text file-textbox + (receive (_w _h text) + (reflow-text (read-all file) + 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)) + ((and edit-button? + (components=? argument edit-button)) + (edit-file file)))))) + (lambda () + (if (components=? argument edit-button) + (loop) + (destroy-form-and-pop form)))))))) |