gnu: retux: Update to 1.6.1. - guix - Wojtek's customized Guix

diff options

author	Tobias Geerinckx-Rice <me@tobias.gr>	2022-06-05 02:00:02 +0200
committer	Tobias Geerinckx-Rice <me@tobias.gr>	2022-06-05 02:00:12 +0200
commit	62b2d37e51018475a41270e25ed4823092f2cc68 (patch)
tree	176661cbb2b51808e59a0c48a00162091ecf6d76 /gnu/packages/cppi.scm
parent	ce21522706ce9603eab0da9eb568ceda9c19cd1a (diff)
download	guix-62b2d37e51018475a41270e25ed4823092f2cc68.tar.gz guix-62b2d37e51018475a41270e25ed4823092f2cc68.zip

gnu: retux: Update to 1.6.1.

* gnu/packages/games.scm (retux): Update to 1.6.1. [arguments]: Don't explicitly return #t from phases. [inputs]: Remove python-six. I found no indication that it's used.

Diffstat (limited to 'gnu/packages/cppi.scm')

0 files changed, 0 insertions, 0 deletions

It can ;;; be used to start user's Shepherd and maybe some other process. It relies on ;;; assumption that /run/user/$UID will be created on login by some login ;;; manager (elogind for example). ;;; ;;; home-activation-service-type provides an @file{activate} guile script, which ;;; do three main things: ;;; ;;; - Sets environment variables to the values declared in ;;; @file{setup-environment} shell script. It's necessary, because user can set ;;; for example XDG_CONFIG_HOME and it should be respected by activation gexp of ;;; symlink-manager. ;;; ;;; - Sets GUIX_NEW_HOME and possibly GUIX_OLD_HOME vars to paths in the store. ;;; Later those variables can be used by activation gexps, for example by ;;; symlink-manager or run-on-change services. ;;; ;;; - Run all activation gexps provided by other home services. ;;; ;;; home-run-on-change-service-type allows to trigger actions during ;;; activation if file or directory specified by pattern is changed. ;;; ;;; Code: (define (home-derivation entries mextensions) "Return as a monadic value the derivation of the 'home' directory containing the given entries." (mlet %store-monad ((extensions (mapm/accumulate-builds identity mextensions))) (lower-object (file-union "home" (append entries (concatenate extensions)))))) (define home-service-type ;; This is the ultimate service type, the root of the home service ;; DAG. The service of this type is extended by monadic name/item ;; pairs. These items end up in the "home-environment directory" as ;; returned by 'home-environment-derivation'. (service-type (name 'home) (extensions '()) (compose identity) (extend home-derivation) (default-value '()) (description "Build the home environment top-level directory, which in turn refers to everything the home environment needs: its packages, configuration files, activation script, and so on."))) (define (packages->profile-entry packages) "Return a system entry for the profile containing PACKAGES." ;; XXX: 'mlet' is needed here for one reason: to get the proper ;; '%current-target' and '%current-target-system' bindings when ;; 'packages->manifest' is called, and thus when the 'package-inputs' ;; etc. procedures are called on PACKAGES. That way, conditionals in those ;; inputs see the "correct" value of these two parameters. See ;; <https://issues.guix.gnu.org/44952>. (mlet %store-monad ((_ (current-target-system))) (return `(("profile" ,(profile (content (packages->manifest (map identity ;;(options->transformation transformations) (delete-duplicates packages eq?)))))))))) ;; MAYBE: Add a list of transformations for packages. It's better to ;; place it in home-profile-service-type to affect all profile ;; packages and prevent conflicts, when other packages relies on ;; non-transformed version of package. (define home-profile-service-type (service-type (name 'home-profile) (extensions (list (service-extension home-service-type packages->profile-entry))) (compose concatenate) (extend append) (description "This is the @dfn{home profile} and can be found in @file{~/.guix-home/profile}. It contains packages and configuration files that the user has declared in their @code{home-environment} record."))) ;; Representation of a literal string. (define-record-type <literal-string> (literal-string str) literal-string? (str literal-string-value)) (define (with-shell-quotation-bindings exp) "Insert EXP, a gexp, in a lexical environment providing the 'shell-single-quote' and 'shell-double-quote' bindings." #~(let* ((quote-string (lambda (value quoted-chars) (list->string (string-fold-right (lambda (chr lst) (if (memq chr quoted-chars) (append (list #\\ chr) lst) (cons chr lst))) '() value)))) (shell-double-quote (lambda (value) ;; Double-quote VALUE, leaving dollar sign as is. (string-append "\"" (quote-string value '(#\" #\\)) "\""))) (shell-single-quote (lambda (value) ;; Single-quote VALUE to enter a literal string. (string-append "'" (quote-string value '(#\')) "'")))) #$exp)) (define (environment-variable-shell-definitions variables) "Return a gexp that evaluates to a list of POSIX shell statements defining VARIABLES, a list of environment variable name/value pairs. The returned code ensures variable values are properly quoted." (with-shell-quotation-bindings #~(string-append #$@(map (match-lambda ((key . #f) "") ((key . #t) #~(string-append "export " #$key "\n")) ((key . (or (? string? value) (? file-like? value) (? gexp? value))) #~(string-append "export " #$key "=" (shell-double-quote #$value) "\n")) ((key . (? literal-string? value)) #~(string-append "export " #$key "=" (shell-single-quote #$(literal-string-value value)) "\n"))) variables)))) (define (environment-variables->setup-environment-script vars) "Return a file that can be sourced by a POSIX compliant shell which initializes the environment. The file will source the home environment profile, set some default environment variables, and set environment variables provided in @code{vars}. @code{vars} is a list of pairs (@code{(key . value)}), @code{key} is a string and @code{value} is a string or gexp. If value is @code{#f} variable will be omitted. If value is @code{#t} variable will be just exported. For any other, value variable will be set to the @code{value} and exported." (define (warn-about-duplicate-definitions) (fold (lambda (x acc) (when (equal? (car x) (car acc)) (warning (G_ "duplicate definition for `~a' environment variable ~%") (car x))) x) (cons "" "") (sort vars (lambda (a b) (string<? (car a) (car b)))))) (warn-about-duplicate-definitions) (with-monad %store-monad (return `(("setup-environment" ;; TODO: It's necessary to source ~/.guix-profile too ;; on foreign distros ,(computed-file "setup-environment" #~(call-with-output-file #$output (lambda (port) (set-port-encoding! port "UTF-8") (display "\ HOME_ENVIRONMENT=$HOME/.guix-home GUIX_PROFILE=\"$HOME_ENVIRONMENT/profile\" PROFILE_FILE=\"$HOME_ENVIRONMENT/profile/etc/profile\" [ -f $PROFILE_FILE ] && . $PROFILE_FILE case $XDG_DATA_DIRS in *$HOME_ENVIRONMENT/profile/share*) ;; *) export XDG_DATA_DIRS=$HOME_ENVIRONMENT/profile/share:$XDG_DATA_DIRS ;; esac case $MANPATH in *$HOME_ENVIRONMENT/profile/share/man*) ;; *) export MANPATH=$HOME_ENVIRONMENT/profile/share/man:$MANPATH esac case $INFOPATH in *$HOME_ENVIRONMENT/profile/share/info*) ;; *) export INFOPATH=$HOME_ENVIRONMENT/profile/share/info:$INFOPATH ;; esac case $XDG_CONFIG_DIRS in *$HOME_ENVIRONMENT/profile/etc/xdg*) ;; *) export XDG_CONFIG_DIRS=$HOME_ENVIRONMENT/profile/etc/xdg:$XDG_CONFIG_DIRS ;; esac case $XCURSOR_PATH in *$HOME_ENVIRONMENT/profile/share/icons*) ;; *) export XCURSOR_PATH=$HOME_ENVIRONMENT/profile/share/icons:$XCURSOR_PATH ;; esac " port) (display #$(environment-variable-shell-definitions vars) port))))))))) (define home-environment-variables-service-type (service-type (name 'home-environment-variables) (extensions (list (service-extension home-service-type environment-variables->setup-environment-script))) (compose concatenate) (extend append) (default-value '()) (description "Set the environment variables."))) (define (files->files-directory files) "Return a @code{files} directory that contains FILES." (define (assert-no-duplicates files) (let loop ((files files) (seen (set))) (match files (() #t) (((file _) rest ...) (when (set-contains? seen file) (raise (formatted-message (G_ "duplicate '~a' entry for files/") file))) (loop rest (set-insert file seen)))))) ;; Detect duplicates early instead of letting them through, eventually ;; leading to a build failure of "files.drv". (assert-no-duplicates files) (file-union "files" files)) ;; Used by symlink-manager (define home-files-directory "files") (define (files-entry files) "Return an entry for the @file{~/.guix-home/files} directory containing FILES." (with-monad %store-monad (return `((,home-files-directory ,(files->files-directory files)))))) (define home-files-service-type (service-type (name 'home-files) (extensions (list (service-extension home-service-type files-entry))) (compose concatenate) (extend append) (default-value '()) (description "Files that will be put in @file{~/.guix-home/files}, and further processed during activation."))) (define xdg-configuration-files-directory ".config") (define (xdg-configuration-files files) "Add .config/ prefix to each file-path in FILES." (map (match-lambda ((file-path . rest) (cons (string-append xdg-configuration-files-directory "/" file-path) rest))) files)) (define home-xdg-configuration-files-service-type (service-type (name 'home-xdg-configuration) (extensions (list (service-extension home-files-service-type xdg-configuration-files))) (compose concatenate) (extend append) (default-value '()) (description "Files that will be put in @file{~/.guix-home/files/.config}, and further processed during activation."))) (define xdg-data-files-directory ".local/share") (define (xdg-data-files files) "Add .local/share prefix to each file-path in FILES." (map (match-lambda ((file-path . rest) (cons (string-append xdg-data-files-directory "/" file-path) rest))) files)) (define home-xdg-data-files-service-type (service-type (name 'home-xdg-data) (extensions (list (service-extension home-files-service-type xdg-data-files))) (compose concatenate) (extend append) (default-value '()) (description "Files that will be put in @file{~/.guix-home/files/.local/share}, and further processed during activation."))) (define %initialize-gettext #~(begin (bindtextdomain %gettext-domain (string-append #$guix "/share/locale")) (textdomain %gettext-domain))) (define (compute-on-first-login-script _ gexps) (program-file "on-first-login" (with-imported-modules (source-module-closure '((guix i18n) (guix diagnostics))) #~(begin (use-modules (guix i18n) (guix diagnostics)) (define (claim-first-run file) (catch #t (lambda () ;; This incantation raises an error if FILE already exists, and ;; creates it otherwise. (close-fdes (open-fdes file (logior O_CREAT O_EXCL O_CLOEXEC))) #t) (const #f))) #$%initialize-gettext (let* ((xdg-runtime-dir (or (getenv "XDG_RUNTIME_DIR") (format #f "/run/user/~a" (getuid)))) (flag-file-path (string-append xdg-runtime-dir "/on-first-login-executed"))) ;; XDG_RUNTIME_DIR dissapears on logout, that means such trick ;; allows to launch on-first-login script on first login only ;; after complete logout/reboot. (if (file-exists? xdg-runtime-dir) (when (claim-first-run flag-file-path) ;; GEXPS can be empty, hence 'begin *unspecified*'. Having just ;; 'begin' without '*unspecified*' leads to ;; "Syntax error: ... sequence of zero expressions in form (begin)" (begin *unspecified* #$@gexps)) ;; TRANSLATORS: 'on-first-login' is the name of a service and ;; shouldn't be translated (warning (G_ "XDG_RUNTIME_DIR doesn't exists, on-first-login script won't execute anything. You can check if xdg runtime directory exists, XDG_RUNTIME_DIR variable is set to appropriate value and manually execute the script by running '$HOME/.guix-home/on-first-login'")))))))) (define (on-first-login-script-entry on-first-login) "Return, as a monadic value, an entry for the on-first-login script in the home environment directory." (with-monad %store-monad (return `(("on-first-login" ,on-first-login))))) (define home-run-on-first-login-service-type (service-type (name 'home-run-on-first-login) (extensions (list (service-extension home-service-type on-first-login-script-entry))) (compose identity) (extend compute-on-first-login-script) (default-value #f) (description "Run gexps on first user login. Can be extended with one gexp."))) (define (compute-activation-script init-gexp gexps) (gexp->script "activate" #~(let* ((he-init-file (lambda (he) (string-append he "/setup-environment"))) (he-path (string-append (getenv "HOME") "/.guix-home")) (new-home-env (getenv "GUIX_NEW_HOME")) (new-home (or new-home-env ;; Absolute path of the directory of the activation ;; file if called interactively. (canonicalize-path (dirname (car (command-line)))))) (old-home-env (getenv "GUIX_OLD_HOME")) (old-home (or old-home-env (if (file-exists? (he-init-file he-path)) (readlink he-path) #f)))) (if (file-exists? (he-init-file new-home)) (let* ((port ((@ (ice-9 popen) open-input-pipe) (format #f "source ~a && ~a -0" (he-init-file new-home) #$(file-append coreutils "/bin/env")))) (result ((@ (ice-9 rdelim) read-delimited) "" port)) (vars (map (lambda (x) (let ((si (string-index x #\=))) (cons (string-take x si) (string-drop x (1+ si))))) ((@ (srfi srfi-1) remove) string-null? (string-split result #\nul))))) (close-port port) (map (lambda (x) (setenv (car x) (cdr x))) vars) (setenv "GUIX_NEW_HOME" new-home) (setenv "GUIX_OLD_HOME" old-home) #$@gexps ;; Do not unset env variable if it was set outside. (unless new-home-env (setenv "GUIX_NEW_HOME" #f)) (unless old-home-env (setenv "GUIX_OLD_HOME" #f))) (format #t "\ Activation script was either called or loaded by file from this directory: ~a It doesn't seem that home environment is somewhere around. Make sure that you call ./activate by symlink from -home store item.\n" new-home))))) (define (activation-script-entry m-activation) "Return, as a monadic value, an entry for the activation script in the home environment directory." (mlet %store-monad ((activation m-activation)) (return `(("activate" ,activation))))) (define home-activation-service-type (service-type (name 'home-activation) (extensions (list (service-extension home-service-type activation-script-entry))) (compose identity) (extend compute-activation-script) (default-value #f) (description "Run gexps to activate the current generation of home environment and update the state of the home directory. @command{activate} script automatically called during reconfiguration or generation switching. This service can be extended with one gexp, but many times, and all gexps must be idempotent."))) ;;; ;;; Service type graph rewriting. ;;; (define (service-type-mapping proc) "Return a procedure that applies PROC to map a service type graph to another one." (define (rewrite extension) (match (proc (service-extension-target extension)) (#f #f) (target (service-extension target (service-extension-compute extension))))) (define replace (mlambdaq (type) (service-type (inherit type) (name (symbol-append 'home- (service-type-name type))) (location (service-type-location type)) (extensions (filter-map rewrite (service-type-extensions type)))))) replace) (define %system/home-service-type-mapping ;; Mapping of System to Home services. (make-hash-table)) (define system->home-service-type ;; Map the given System service type to the corresponding Home service type. (let () (define (replace type) (define replacement (hashq-ref %system/home-service-type-mapping type *unspecified*)) (if (eq? replacement *unspecified*) type replacement)) (service-type-mapping replace))) (define-syntax define-service-type-mapping (syntax-rules (=>) ((_ system-type => home-type) (hashq-set! %system/home-service-type-mapping system-type home-type)))) (define-syntax define-service-type-mappings (syntax-rules (=>) ((_ (system-type => home-type) ...) (begin (define-service-type-mapping system-type => home-type) ...)))) (define-service-type-mappings (system-service-type => home-service-type) (activation-service-type => home-activation-service-type) (profile-service-type => home-profile-service-type)) ;;; ;;; On-change. ;;; (define (compute-on-change-gexp eval-gexps? pattern-gexp-tuples) (with-imported-modules (source-module-closure '((guix i18n))) #~(begin (use-modules (guix i18n)) #$%initialize-gettext (define (equal-regulars? file1 file2) "Check if FILE1 and FILE2 are bit for bit identical." (let* ((cmp-binary #$(file-append (@ (gnu packages base) diffutils) "/bin/cmp")) (stats1 (lstat file1)) (stats2 (lstat file2))) (cond ((= (stat:ino stats1) (stat:ino stats2)) #t) ((not (= (stat:size stats1) (stat:size stats2))) #f) (else (= (system* cmp-binary file1 file2) 0))))) (define (equal-symlinks? symlink1 symlink2) "Check if SYMLINK1 and SYMLINK2 are pointing to the same target." (string=? (readlink symlink1) (readlink symlink2))) (define (equal-directories? dir1 dir2) "Check if DIR1 and DIR2 have the same content." (define (ordinary-file file) (not (or (string=? file ".") (string=? file "..")))) (let* ((files1 (scandir dir1 ordinary-file)) (files2 (scandir dir2 ordinary-file))) (if (equal? files1 files2) (map (lambda (file) (equal-files? (string-append dir1 "/" file) (string-append dir2 "/" file))) files1) #f))) (define (equal-files? file1 file2) "Compares files, symlinks or directories of the same type." (case (file-type file1) ((directory) (equal-directories? file1 file2)) ((symlink) (equal-symlinks? file1 file2)) ((regular) (equal-regulars? file1 file2)) (else (display "The file type is unsupported by on-change service.\n") #f))) (define (file-type file) (stat:type (lstat file))) (define (something-changed? file1 file2) (cond ((and (not (file-exists? file1)) (not (file-exists? file2))) #f) ((or (not (file-exists? file1)) (not (file-exists? file2))) #t) ((not (eq? (file-type file1) (file-type file2))) #t) (else (not (equal-files? file1 file2))))) (define expressions-to-eval (map (lambda (x) (let* ((file1 (string-append (or (getenv "GUIX_OLD_HOME") "/gnu/store/non-existing-generation") "/" (car x))) (file2 (string-append (getenv "GUIX_NEW_HOME") "/" (car x))) (_ (format #t (G_ "Comparing ~a and\n~10t~a...") file1 file2)) (any-changes? (something-changed? file1 file2)) (_ (format #t (G_ " done (~a)\n") (if any-changes? "changed" "same")))) (if any-changes? (cadr x) ""))) '#$pattern-gexp-tuples)) (if #$eval-gexps? (begin ;;; TRANSLATORS: 'on-change' is the name of a service type, it ;;; probably shouldn't be translated. (display (G_ "Evaluating on-change gexps.\n\n")) (for-each primitive-eval expressions-to-eval) (display (G_ "On-change gexps evaluation finished.\n\n"))) (display "\ On-change gexps won't be evaluated; evaluation has been disabled in the service configuration"))))) (define home-run-on-change-service-type (service-type (name 'home-run-on-change) (extensions (list (service-extension home-activation-service-type identity))) (compose concatenate) (extend compute-on-change-gexp) (default-value #t) (description "\ G-expressions to run if the specified files have changed since the last generation. The extension should be a list of lists where the first element is the pattern for file or directory that expected to be changed, and the second element is the G-expression to be evaluated."))) ;;; ;;; Provenance tracking. ;;; (define home-provenance-service-type (service-type (name 'home-provenance) (extensions (list (service-extension home-service-type (service-extension-compute (first (service-type-extensions provenance-service-type)))))) (default-value #f) ;the HE config file (description "\ Store provenance information about the home environment in the home environment itself: the channels used when building the home environment, and its configuration file, when available."))) (define sexp->home-provenance sexp->system-provenance) (define home-provenance system-provenance) ;;; ;;; Searching ;;; (define (parent-directory directory) "Get the parent directory of DIRECTORY" (string-join (drop-right (string-split directory #\/) 1) "/")) (define %guix-home-root-directory ;; Absolute file name of the module hierarchy. (parent-directory (dirname (dirname (search-path %load-path "gnu/home/services.scm"))))) (define %service-type-path ;; Search path for service types. (make-parameter `((,%guix-home-root-directory . "gnu/home/services")))) (define (all-home-service-modules) "Return the default set of `home service' modules." (cons (resolve-interface '(gnu home services)) (all-modules (%service-type-path) #:warn warn-about-load-error))) (define* (fold-home-service-types proc seed) (fold-service-types proc seed (all-home-service-modules))) (define lookup-home-service-types (let ((table (delay (fold-home-service-types (lambda (type result) (vhash-consq (service-type-name type) type result)) vlist-null)))) (lambda (name) "Return the list of services with the given NAME (a symbol)." (vhash-foldq* cons '() name (force table)))))


context:
space:
mode: