;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2018 Mathieu Othacehe <m.othacehe@gmail.com>
;;; Copyright © 2019 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
;;; GNU Guix is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; GNU Guix is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.

(define-module (gnu installer newt final)
  #:use-module (gnu installer final)
  #:use-module (gnu installer parted)
  #:use-module (gnu installer steps)
  #:use-module (gnu installer utils)
  #:use-module (gnu installer newt page)
  #:use-module (gnu installer newt utils)
  #:use-module (guix i18n)
  #:use-module (srfi srfi-34)
  #:use-module (srfi srfi-35)
  #:use-module (newt)
  #:export (run-final-page))

(define* (strip-prefix file #:optional (prefix (%installer-target-dir)))
  "Strip PREFIX from FILE, if PREFIX actually is a prefix of FILE."
  (if (string-prefix? prefix file)
      (string-drop file (string-length prefix))
      file))

(define (run-config-display-page)
  (let ((width (%configuration-file-width))
        (height (nearest-exact-integer
                 (/ (screen-rows) 2))))
    (run-file-textbox-page
     #:info-text (format #f (G_ "\
We're now ready to proceed with the installation! \
A system configuration file has been generated, it is displayed below.  \
This file will be available as '~a' on the installed system.  \
The new system will be created from this file once you've pressed OK.  \
This will take a few minutes.")
                         (strip-prefix (%installer-configuration-file)))
     #:title (G_ "Configuration file")
     #:file (%installer-configuration-file)
     #:info-textbox-width width
     #:file-textbox-width width
     #:file-textbox-height height
     #:exit-button-callback-procedure
     (lambda ()
       (raise
        (condition
         (&installer-step-abort)))))))

(define (run-install-success-page)
  (message-window
   (G_ "Installation complete")
   (G_ "Reboot")
   (G_ "Congratulations!  Installation is now complete.  \
You may remove the device containing the installation image and \
press the button to reboot."))

  ;; Return success so that the installer happily reboots.
  'success)

(define (run-install-failed-page)
  (choice-window
   (G_ "Installation failed")
   (G_ "Restart installer")
   (G_ "Retry system install")
   (G_ "The final system installation step failed.  You can retry the \
last step, or restart the installer.")))

(define* (run-install-shell locale
                            #:key (users '()))
  (clear-screen)
  (newt-suspend)
  (let ((install-ok? (install-system locale #:users users)))
    (newt-resume)
    install-ok?))

(define (run-final-page result prev-steps)
  (let* ((configuration   (format-configuration prev-steps result))
         (user-partitions (result-step result 'partition))
         (locale          (result-step result 'locale))
         (users           (result-step result 'user))
         (install-ok?
          (with-mounted-partitions
           user-partitions
           (configuration->file configuration)
           (run-config-display-page)
           (run-install-shell locale #:users users))))
    (if install-ok?
        (run-install-success-page)
        (run-install-failed-page))))
><td>Ryan Prior</td></tr>
<tr><td><span title='2020-11-26 23:39:16 +0100'>2020-11-26</span></td><td><a href='/guix/commit/gnu/packages/emacs.scm?id=2a1eda5a9ba55aca4a205408c8f3988ffff7e03b'>gnu: Add emacs-next-pgtk.</a><span class='msg-avail'>...</span></td><td>Andrew Tropin</td></tr>
<tr><td><span title='2020-11-11 21:37:11 +0100'>2020-11-11</span></td><td><a href='/guix/commit/gnu/packages/emacs.scm?id=b05c96d93d974723142846f94790f349913c0df5'>gnu: emacs.scm: Remove unused module import.</a><span class='msg-avail'>...</span></td><td>Marius Bakke</td></tr>
<tr><td><span title='2020-11-03 12:07:18 +0100'>2020-11-03</span></td><td><a href='/guix/commit/gnu/packages/emacs.scm?id=c41c089ad0d686a2de1728147a1a2d921fa7c44c'>Revert "gnu: emacs: Make strip-double-wrap more robust."</a><span class='msg-avail'>...</span></td><td>Nicolas Goaziou</td></tr>
<tr><td><span title='2020-11-03 10:30:03 +0100'>2020-11-03</span></td><td><a href='/guix/commit/gnu/packages/emacs.scm?id=b107a19ffb6a6abb7bde3436f3fa359071bd1f5c'>gnu: emacs: Make strip-double-wrap more robust.</a><span class='msg-avail'>...</span></td><td>Morgan Smith</td></tr>
<tr><td><span title='2020-10-01 11:03:56 -0400'>2020-10-01</span></td><td><a href='/guix/commit/gnu/packages/emacs.scm?id=f88fea0eaa5796303790450ee4543a6d7e61a06e'>gnu: emacs-next: Fix load path and version.</a><span class='msg-avail'>...</span></td><td>Morgan Smith</td></tr>
<tr><td><span title='2020-09-02 17:17:37 +0200'>2020-09-02</span></td><td><a href='/guix/commit/gnu/packages/emacs.scm?id=562f7e3fdb01924749ff78aacdee0dc7eedab0d9'>gnu: Add emacs-next.</a><span class='msg-avail'>...</span></td><td>Morgan Smith</td></tr>
<tr><td><span title='2020-08-31 08:48:54 +0200'>2020-08-31</span></td><td><a href='/guix/commit/gnu/packages/emacs.scm?id=68be4da83087d0faff227c61ca93c7679230c998'>gnu: emacs: Strip double wrap.</a><span class='msg-avail'>...</span></td><td>Leo Prikler</td></tr>
<tr><td><span title='2020-08-29 15:58:53 +0200'>2020-08-29</span></td><td><a href='/guix/commit/gnu/packages/emacs.scm?id=6c77a5040604ebb7c0196f47520cf5fcc30c2087'>Revert "gnu: emacs: Strip double wrap."</a><span class='msg-avail'>...</span></td><td>Mathieu Othacehe</td></tr>
<tr><td><span title='2020-08-29 13:24:50 +0200'>2020-08-29</span></td><td><a href='/guix/commit/gnu/packages/emacs.scm?id=0ec6b8afd7e7a6c288fbf48c5779f2e0bdaffb55'>gnu: emacs: Strip double wrap.</a><span class='msg-avail'>...</span></td><td>Leo Prikler</td></tr>
<tr><td><span title='2020-08-28 00:13:51 -0400'>2020-08-28</span></td><td><a href='/guix/commit/gnu/packages/emacs.scm?id=36a09d185343375a5cba370431870f9c4435d623'>gnu: emacs: Update to 27.1.</a><span class='msg-avail'>...</span></td><td>Mark H Weaver</td></tr>
<tr><td><span title='2020-08-03 12:26:02 +0200'>2020-08-03</span></td><td><a href='/guix/commit/gnu/packages/emacs.scm?id=f574f859ee7343d894ecf7318fa53b7a73426775'>gnu: emacs: Ignore empty XIM styles.</a><span class='msg-avail'>...</span></td><td>Leo Prikler</td></tr>