;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2018 Mathieu Othacehe ;;; Copyright © 2019, 2020 Ludovic Courtès ;;; Copyright © 2019 Tobias Geerinckx-Rice ;;; ;;; 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 . (define-module (gnu installer newt user) #:use-module (gnu installer user) #:use-module (gnu installer newt page) #:use-modu
aboutsummaryrefslogtreecommitdiff
blob: 0368779240e9e0b8cd31ac54a502dfb0b8a59e79 (about) (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2014 Marek Benc <merkur32@gmail.com>
;;; Copyright © 2016 Efraim Flashner <efraim@flashner.co.il>
;;; Copyright © 2018 Tobias Geerinckx-Rice <me@tobias.gr>
;;;
;;; 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 packages fribidi)
  #:use-module (guix packages)
  #:use-module (guix download)
  #:use-module (guix build-system gnu)
  #:use-module (guix licenses))

(define-public fribidi
  (package
    (name "fribidi")
    (version "1.0.2")
    (source
      (origin
        (method url-fetch)
        (uri
         (string-append "https://github.com/fribidi/fribidi/releases"
                        "/download/v" version "/fribidi-" version
                         ".tar.bz2"))
        (sha256
          (base32 "0aw3i1g96axbr96flw4543dvhb8zlgb0w8314ks6cq2g1i9invdx"))))
    (build-system gnu-build-system)
    (arguments
     `(#:configure-flags
       (list "--disable-docs")))        ; TODO: enable; requires c2man
    (synopsis "Implementation of the Unicode bidirectional algorithm")
    (description
     "GNU FriBidi is an implementation of the Unicode Bidirectional
Algorithm.  This algorithm is used to properly display text in left-to-right
or right-to-left ordering as necessary.")
    (home-page "https://github.com/fribidi/fribidi")
    (license lgpl2.1+)))
stroy-form-and-pop form))))))) (define* (confirm-password password #:optional (try-again (const #f))) "Ask the user to confirm PASSWORD, a possibly empty string. Call TRY-AGAIN, a thunk, if the confirmation doesn't match PASSWORD, and return its result." (define confirmation (run-input-page (G_ "Please confirm the password.") (G_ "Password confirmation required") #:allow-empty-input? #t #:input-visibility-checkbox? #t)) (if (string=? password confirmation) password (begin (run-error-page (G_ "Password mismatch, please try again.") (G_ "Password error")) (try-again)))) (define (run-root-password-page) (define password ;; TRANSLATORS: Leave "root" untranslated: it refers to the name of the ;; system administrator account. (run-input-page (G_ "Please choose a password for the system \ administrator (\"root\").") (G_ "System administrator password") #:input-visibility-checkbox? #t)) (confirm-password password run-root-password-page)) (define (run-user-page) (define (run users) (let* ((listbox (make-listbox -1 -1 10 (logior FLAG-SCROLL FLAG-BORDER))) (info-textbox (make-reflowed-textbox -1 -1 (G_ "Please add at least one user to system\ using the 'Add' button.") 40 #:flags FLAG-BORDER)) (add-button (make-compact-button -1 -1 (G_ "Add"))) (del-button (make-compact-button -1 -1 (G_ "Delete"))) (listbox-button-grid (apply vertically-stacked-grid GRID-ELEMENT-COMPONENT add-button `(,@(if (null? users) '() (list GRID-ELEMENT-COMPONENT del-button))))) (ok-button (make-button -1 -1 (G_ "OK"))) (exit-button (make-button -1 -1 (G_ "Exit"))) (title (G_ "User creation")) (grid (vertically-stacked-grid GRID-ELEMENT-COMPONENT info-textbox GRID-ELEMENT-SUBGRID (horizontal-stacked-grid GRID-ELEMENT-COMPONENT listbox GRID-ELEMENT-SUBGRID listbox-button-grid) GRID-ELEMENT-SUBGRID (horizontal-stacked-grid GRID-ELEMENT-COMPONENT ok-button GRID-ELEMENT-COMPONENT exit-button))) (sorted-users (sort users (lambda (a b) (string<= (user-name a) (user-name b))))) (listbox-elements (map (lambda (user) `((key . ,(append-entry-to-listbox listbox (user-name user))) (user . ,user))) sorted-users)) (form (make-form))) (add-form-to-grid grid form #t) (make-wrapped-grid-window grid title) (if (null? users) (set-current-component form add-button) (set-current-component form ok-button)) (receive (exit-reason argument) (run-form-with-clients form '(add-users)) (dynamic-wind (const #t) (lambda () (match exit-reason ('exit-component (cond ((components=? argument add-button) (run (cons (run-user-add-page) users))) ((components=? argument del-button) (let* ((current-user-key (current-listbox-entry listbox)) (users (map (cut assoc-ref <> 'user) (remove (lambda (element) (equal? (assoc-ref element 'key) current-user-key)) listbox-elements)))) (run users))) ((components=? argument ok-button) (when (null? users) (run-error-page (G_ "Please create at least one user.") (G_ "No user")) (run users)) (reverse users)) ((components=? argument exit-button) (abort-to-prompt 'installer-step 'abort)))) ('exit-fd-ready ;; Read the complete user list at once. (match argument ((('user ('name names) ('real-name real-names) ('home-directory homes) ('password passwords)) ..1) (map (lambda (name real-name home password) (user (name name) (real-name real-name) (home-directory home) (password (make-secret password)))) names real-names homes passwords)))))) (lambda () (destroy-form-and-pop form)))))) ;; Add a "root" user simply to convey the root password. (cons (user (name "root") (home-directory "/root") (password (make-secret (run-root-password-page)))) (run '())))