From 9ced0f376bb7d4b9351a03da2415e26126b6418c Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Sun, 12 Jan 2020 21:59:01 +0100 Subject: installer: Add an "Edit" button on the final page. Fixes . Reported by . * gnu/installer/newt/page.scm (edit-file): New procedure. (run-file-textbox-page): Add #:edit-button? and #:editor-locale parameters. Remove 'file-text' and add 'edit-button', and add it to the horizontal stacked grid when EXIT-BUTTON? is true. Wrap body in 'loop'. Handle case where ARGUMENT is EDIT-BUTTON by calling 'loop'. * gnu/installer/newt/final.scm (run-config-display-page): Add #:locale parameter. Pass #:edit-button? and #:editor-locale to 'run-file-textbox-page'. (run-final-page): Pass LOCALE to 'run-config-display-page'. --- gnu/installer/newt/final.scm | 8 +++-- gnu/installer/newt/page.scm | 78 +++++++++++++++++++++++++++++--------------- 2 files changed, 56 insertions(+), 30 deletions(-) (limited to 'gnu/installer') 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 -;;; Copyright © 2019 Ludovic Courtès +;;; Copyright © 2019, 2020 Ludovic Courtès ;;; ;;; 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 -;;; Copyright © 2019 Ludovic Courtès +;;; Copyright © 2019, 2020 Ludovic Courtès ;;; Copyright © 2019 Tobias Geerinckx-Rice ;;; ;;; 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)))))))) -- cgit 1.4.1