gnu/installer/newt/welcome.scm

   1 ;;; GNU Guix --- Functional package management for GNU
   2 ;;; Copyright © 2018 Mathieu Othacehe <m.othacehe@gmail.com>
   3 ;;;
   4 ;;; This file is part of GNU Guix.
   5 ;;;
   6 ;;; GNU Guix is free software; you can redistribute it and/or modify it
   7 ;;; under the terms of the GNU General Public License as published by
   8 ;;; the Free Software Foundation; either version 3 of the License, or (at
   9 ;;; your option) any later version.
  10 ;;;
  11 ;;; GNU Guix is distributed in the hope that it will be useful, but
  12 ;;; WITHOUT ANY WARRANTY; without even the implied warranty of
  13 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  14
  15 ;;;
  16 ;;; You should have received a copy of the GNU General Public License
  17 ;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
  18
  19 (define-module (gnu installer newt welcome)
  20   #:use-module (gnu installer utils)
  21   #:use-module (gnu installer newt utils)
  22   #:use-module (guix build syscalls)
  23   #:use-module (guix i18n)
  24   #:use-module (ice-9 match)
  25   #:use-module (ice-9 receive)
  26   #:use-module (newt)
  27   #:export (run-welcome-page))
  28
  29 ;; Expected width and height for the logo.
  30 (define logo-width (make-parameter 43))
  31 (define logo-height (make-parameter 19))
  32
  33 (define info-textbox-width (make-parameter 70))
  34 (define options-listbox-height (make-parameter 5))
  35
  36 (define* (run-menu-page title info-text logo
  37                         #:key
  38                         listbox-items
  39                         listbox-item->text)
  40   "Run a page with the given TITLE, to ask the user to choose between
  41 LISTBOX-ITEMS displayed in a listbox. The listbox items are converted to text
  42 using LISTBOX-ITEM->TEXT procedure. Display the textual LOGO in the center of
  43 the page. Contrary to other pages, we cannot resort to grid layouts, because
  44 we want this page to occupy all the screen space available."
  45   (define (fill-listbox listbox items)
  46     (map (lambda (item)
  47            (let* ((text (listbox-item->text item))
  48                   (key (append-entry-to-listbox listbox text)))
  49              (cons key item)))
  50          items))
  51
  52   (let* ((logo-textbox
  53           (make-textbox -1 -1 (logo-width) (logo-height) 0))
  54          (info-textbox
  55           (make-reflowed-textbox -1 -1
  56                                  info-text
  57                                  (info-textbox-width)))
  58          (options-listbox
  59           (make-listbox -1 -1
  60                         (options-listbox-height)
  61                         (logior FLAG-BORDER FLAG-RETURNEXIT)))
  62          (keys (fill-listbox options-listbox listbox-items))
  63          (grid (vertically-stacked-grid
  64                 GRID-ELEMENT-COMPONENT logo-textbox
  65                 GRID-ELEMENT-COMPONENT info-textbox
  66                 GRID-ELEMENT-COMPONENT options-listbox))
  67          (form (make-form)))
  68
  69     (set-textbox-text logo-textbox (read-all logo))
  70
  71     (add-form-to-grid grid form #t)
  72     (make-wrapped-grid-window grid title)
  73
  74     (receive (exit-reason argument)
  75         (run-form form)
  76       (dynamic-wind
  77         (const #t)
  78         (lambda ()
  79           (when (eq? exit-reason 'exit-component)
  80             (cond
  81              ((components=? argument options-listbox)
  82               (let* ((entry (current-listbox-entry options-listbox))
  83                      (item (assoc-ref keys entry)))
  84                 (match item
  85                   ((text . proc)
  86                    (proc))))))))
  87         (lambda ()
  88           (destroy-form-and-pop form))))))
  89
  90 (define (run-welcome-page logo)
  91   "Run a welcome page with the given textual LOGO displayed at the center of
  92 the page. Ask the user to choose between manual installation, graphical
  93 installation and reboot."
  94   (run-menu-page
  95    (G_ "GNU GuixSD install")
  96    (G_ "Welcome to GNU GuixSD installer!
  97
  98 Please note that the present graphical installer is still under heavy \
  99 development, so you might want to prefer using the shell based process. \
 100 The documentation is accessible at any time by pressing CTRL-ALT-F2.")
 101    logo
 102    #:listbox-items
 103    `((,(G_ "Graphical install using a terminal based interface")
 104       .
 105       ,(const #t))
 106      (,(G_ "Install using the shell based process")
 107       .
 108       ,(lambda ()
 109          ;; Switch to TTY3, where a root shell is available for shell based
 110          ;; install. The other root TTY's would have been ok too.
 111          (system* "chvt" "3")
 112          (run-welcome-page logo)))
 113      (,(G_ "Reboot")
 114       .
 115       ,(lambda ()
 116          (newt-finish)
 117          (reboot))))
 118    #:listbox-item->text car))