diff options
Diffstat (limited to 'etc')
| -rwxr-xr-x | etc/committer.scm.in | 197 | ||||
| -rw-r--r-- | etc/completion/bash/guix | 61 | ||||
| -rw-r--r-- | etc/news.scm | 163 | ||||
| -rw-r--r-- | etc/release-manifest.scm | 4 | ||||
| -rw-r--r-- | etc/snippets/text-mode/guix-commit-message-remove-package | 13 | ||||
| -rw-r--r-- | etc/system-tests.scm | 39 |
6 files changed, 346 insertions, 131 deletions
diff --git a/etc/committer.scm.in b/etc/committer.scm.in index 5a57d51577..e7f1ca8c45 100755 --- a/etc/committer.scm.in +++ b/etc/committer.scm.in @@ -6,6 +6,7 @@ ;;; Copyright © 2020, 2021 Ricardo Wurmus <rekado@elephly.net> ;;; Copyright © 2021 Sarah Morgensen <iskarian@mgsn.dev> ;;; Copyright © 2021 Xinglu Chen <public@yoctocell.xyz> +;;; Copyright © 2022 Maxim Cournoyer <maxim.cournoyer@gmail.com> ;;; ;;; This file is part of GNU Guix. ;;; @@ -28,19 +29,19 @@ ;;; Code: -(import (sxml xpath) - (srfi srfi-1) - (srfi srfi-2) - (srfi srfi-9) - (srfi srfi-11) - (srfi srfi-26) - (ice-9 format) - (ice-9 popen) - (ice-9 match) - (ice-9 rdelim) - (ice-9 regex) - (ice-9 textual-ports) - (guix gexp)) +(use-modules ((sxml xpath) #:prefix xpath:) + (srfi srfi-1) + (srfi srfi-2) + (srfi srfi-9) + (srfi srfi-11) + (srfi srfi-26) + (ice-9 format) + (ice-9 popen) + (ice-9 match) + (ice-9 rdelim) + (ice-9 regex) + (ice-9 textual-ports) + (guix gexp)) (define* (break-string str #:optional (max-line-length 70)) "Break the string STR into lines that are no longer than MAX-LINE-LENGTH. @@ -100,12 +101,16 @@ LINE-NO in PORT." (read-line port) (loop (1- i) last-top-level-sexp)))))) +;;; Whether the hunk contains a newly added package (definition), a removed +;;; package (removal) or something else (#false). +(define hunk-types '(addition removal #false)) + (define-record-type <hunk> (make-hunk file-name old-line-number new-line-number diff-lines - definition?) + type) hunk? (file-name hunk-file-name) ;; Line number before the change @@ -114,8 +119,8 @@ LINE-NO in PORT." (new-line-number hunk-new-line-number) ;; The full diff to be used with "git apply --cached" (diff-lines hunk-diff-lines) - ;; Does this hunk add a definition? - (definition? hunk-definition?)) + ;; Does this hunk add or remove a package? + (type hunk-type)) ;one of 'hunk-types' (define* (hunk->patch hunk #:optional (port (current-output-port))) (let ((file-name (hunk-file-name hunk))) @@ -133,25 +138,30 @@ LINE-NO in PORT." ;; new definitions with changes to existing ;; definitions. "--unified=1" - "gnu"))) + "--" "gnu"))) (define (extract-line-number line-tag) (abs (string->number (car (string-split line-tag #\,))))) (define (read-hunk) (let loop ((lines '()) - (definition? #false)) + (type #false)) (let ((line (read-line port 'concat))) (cond ((eof-object? line) - (values (reverse lines) definition?)) + (values (reverse lines) type)) ((or (string-prefix? "@@ " line) (string-prefix? "diff --git" line)) (unget-string port line) - (values (reverse lines) definition?)) + (values (reverse lines) type)) (else (loop (cons line lines) - (or definition? - (string-prefix? "+(define" line)))))))) + (or type + (cond + ((string-prefix? "+(define" line) + 'addition) + ((string-prefix? "-(define" line) + 'removal) + (else #false))))))))) (define info (let loop ((acc '()) (file-name #f)) @@ -166,13 +176,13 @@ LINE-NO in PORT." (match (string-split line #\space) ((_ old-start new-start . _) (let-values - (((diff-lines definition?) (read-hunk))) + (((diff-lines type) (read-hunk))) (loop (cons (make-hunk file-name (extract-line-number old-start) (extract-line-number new-start) (cons (string-append line "\n") diff-lines) - definition?) acc) + type) acc) file-name))))) (else (loop acc file-name)))))) (close-pipe port) @@ -214,10 +224,10 @@ corresponding to the top-level definition containing the staged changes." (define* (change-commit-message file-name old new #:optional (port (current-output-port))) "Print ChangeLog commit message for changes between OLD and NEW." (define (get-values expr field) - (match ((sxpath `(// ,field quasiquote *)) expr) + (match ((xpath:sxpath `(// ,field quasiquote *)) expr) (() ;; New-style plain lists - (match ((sxpath `(// ,field list *)) expr) + (match ((xpath:sxpath `(// ,field list *)) expr) ((inner) inner) (_ '()))) ;; Old-style labelled inputs @@ -234,7 +244,7 @@ corresponding to the top-level definition containing the staged changes." (define variable-name (second old)) (define version - (and=> ((sxpath '(// version *any*)) new) + (and=> ((xpath:sxpath '(// version *any*)) new) first)) (format port "gnu: ~a: Update to ~a.~%~%* ~a (~a): Update to ~a.~%" @@ -262,10 +272,18 @@ corresponding to the top-level definition containing the staged changes." (listify added)))))))))) '(inputs propagated-inputs native-inputs))) -(define* (add-commit-message file-name variable-name #:optional (port (current-output-port))) - "Print ChangeLog commit message for a change to FILE-NAME adding a definition." - (format port - "gnu: Add ~a.~%~%* ~a (~a): New variable.~%" +(define* (add-commit-message file-name variable-name + #:optional (port (current-output-port))) + "Print ChangeLog commit message for a change to FILE-NAME adding a +definition." + (format port "gnu: Add ~a.~%~%* ~a (~a): New variable.~%" + variable-name file-name variable-name)) + +(define* (remove-commit-message file-name variable-name + #:optional (port (current-output-port))) + "Print ChangeLog commit message for a change to FILE-NAME removing a +definition." + (format port "gnu: Remove ~a.~%~%* ~a (~a): Delete variable.~%" variable-name file-name variable-name)) (define* (custom-commit-message file-name variable-name message changelog @@ -344,66 +362,67 @@ modifying." (() (display "Nothing to be done.\n" (current-error-port))) (hunks - (let-values - (((definitions changes) - (partition hunk-definition? hunks))) + (let-values (((definitions changes) (partition hunk-type hunks))) + ;; Additions/removals. + (for-each + (lambda (hunk) + (and-let* ((define-line (find (cut string-match "(\\+|-)\\(define" <>) + (hunk-diff-lines hunk))) + (variable-name (and=> (string-tokenize define-line) + second)) + (commit-message-proc (match (hunk-type hunk) + ('addition add-commit-message) + ('removal remove-commit-message)))) + (commit-message-proc (hunk-file-name hunk) variable-name) + (let ((port (open-pipe* OPEN_WRITE + "git" "apply" + "--cached" + "--unidiff-zero"))) + (hunk->patch hunk port) + (unless (eqv? 0 (status:exit-val (close-pipe port))) + (error "Cannot apply"))) - ;; Additions. - (for-each (lambda (hunk) - (and-let* - ((define-line (find (cut string-prefix? "+(define" <>) - (hunk-diff-lines hunk))) - (variable-name (and=> (string-tokenize define-line) second))) - (add-commit-message (hunk-file-name hunk) variable-name) - (let ((port (open-pipe* OPEN_WRITE - "git" "apply" - "--cached" - "--unidiff-zero"))) - (hunk->patch hunk port) - (unless (eqv? 0 (status:exit-val (close-pipe port))) - (error "Cannot apply"))) + (let ((port (open-pipe* OPEN_WRITE "git" "commit" "-F" "-"))) + (commit-message-proc (hunk-file-name hunk) variable-name port) + (usleep %delay) + (unless (eqv? 0 (status:exit-val (close-pipe port))) + (error "Cannot commit")))) + (usleep %delay)) + definitions)) - (let ((port (open-pipe* OPEN_WRITE "git" "commit" "-F" "-"))) - (add-commit-message (hunk-file-name hunk) - variable-name port) - (usleep %delay) + ;; Changes. + (for-each + (match-lambda + ((new old . hunks) + (for-each (lambda (hunk) + (let ((port (open-pipe* OPEN_WRITE + "git" "apply" + "--cached" + "--unidiff-zero"))) + (hunk->patch hunk port) (unless (eqv? 0 (status:exit-val (close-pipe port))) - (error "Cannot commit")))) - (usleep %delay)) - definitions) - - ;; Changes. - (for-each (match-lambda - ((new old . hunks) - (for-each (lambda (hunk) - (let ((port (open-pipe* OPEN_WRITE - "git" "apply" - "--cached" - "--unidiff-zero"))) - (hunk->patch hunk port) - (unless (eqv? 0 (status:exit-val (close-pipe port))) - (error "Cannot apply"))) - (usleep %delay)) - hunks) - (define copyright-line - (any (lambda (line) (and=> (string-prefix? "+;;; Copyright ©" line) - (const line))) - (hunk-diff-lines (first hunks)))) - (cond - (copyright-line - (add-copyright-line copyright-line)) - (else - (let ((port (open-pipe* OPEN_WRITE "git" "commit" "-F" "-"))) - (change-commit-message* (hunk-file-name (first hunks)) - old new) - (change-commit-message* (hunk-file-name (first hunks)) - old new - port) - (usleep %delay) - (unless (eqv? 0 (status:exit-val (close-pipe port))) - (error "Cannot commit"))))))) - ;; XXX: we recompute the hunks here because previous - ;; insertions lead to offsets. - (new+old+hunks (diff-info))))))) + (error "Cannot apply"))) + (usleep %delay)) + hunks) + (define copyright-line + (any (lambda (line) (and=> (string-prefix? "+;;; Copyright ©" line) + (const line))) + (hunk-diff-lines (first hunks)))) + (cond + (copyright-line + (add-copyright-line copyright-line)) + (else + (let ((port (open-pipe* OPEN_WRITE "git" "commit" "-F" "-"))) + (change-commit-message* (hunk-file-name (first hunks)) + old new) + (change-commit-message* (hunk-file-name (first hunks)) + old new + port) + (usleep %delay) + (unless (eqv? 0 (status:exit-val (close-pipe port))) + (error "Cannot commit"))))))) + ;; XXX: we recompute the hunks here because previous + ;; insertions lead to offsets. + (new+old+hunks (diff-info)))))) (apply main (cdr (command-line))) diff --git a/etc/completion/bash/guix b/etc/completion/bash/guix index 6b1b70aac1..7b1f639371 100644 --- a/etc/completion/bash/guix +++ b/etc/completion/bash/guix @@ -117,58 +117,59 @@ _guix_is_removing () $result } +_guix_is_short_option () +{ + case "${COMP_WORDS[$COMP_CWORD - 1]}" in + --*) false;; + -*$1) true ;; + *) false ;; + esac +} + +_guix_is_long_option () +{ + # Don't handle (non-GNU?) ‘--long-option VALUE’, as Guix doesn't either. + case "${COMP_WORDS[$COMP_CWORD]}" in + --$1=*) true ;; + *) false ;; + esac +} + _guix_is_dash_f () { - [ "${COMP_WORDS[$COMP_CWORD - 1]}" = "-f" ] \ - || { case "${COMP_WORDS[$COMP_CWORD]}" in - --file=*|--install-from-file=*) true;; - *) false;; - esac } + _guix_is_short_option f || + _guix_is_long_option file || + _guix_is_long_option install-from-file } _guix_is_dash_l () { - [ "${COMP_WORDS[$COMP_CWORD - 1]}" = "-l" ] \ - || { case "${COMP_WORDS[$COMP_CWORD]}" in - --load=*) true;; - *) false;; - esac } + _guix_is_short_option l || + _guix_is_long_option load } _guix_is_dash_L () { - [ "${COMP_WORDS[$COMP_CWORD - 1]}" = "-L" ] \ - || { case "${COMP_WORDS[$COMP_CWORD]}" in - --load-path=*) true;; - *) false;; - esac } + _guix_is_short_option L || + _guix_is_long_option load-path } _guix_is_dash_m () { - [ "${COMP_WORDS[$COMP_CWORD - 1]}" = "-m" ] \ - || { case "${COMP_WORDS[$COMP_CWORD]}" in - --manifest=*) true;; - *) false;; - esac } + _guix_is_short_option m || + _guix_is_long_option manifest } _guix_is_dash_C () { - [ "${COMP_WORDS[$COMP_CWORD - 1]}" = "-C" ] \ - || { case "${COMP_WORDS[$COMP_CWORD]}" in - --channels=*) true;; - *) false;; - esac } + _guix_is_short_option C || + _guix_is_long_option channels } _guix_is_dash_p () { - [ "${COMP_WORDS[$COMP_CWORD - 1]}" = "-p" ] \ - || { case "${COMP_WORDS[$COMP_CWORD]}" in - --profile=*) true;; - *) false;; - esac } + _guix_is_short_option p || + _guix_is_long_option profile } _guix_complete_file () diff --git a/etc/news.scm b/etc/news.scm index 56b90501ae..7b14dfb6c6 100644 --- a/etc/news.scm +++ b/etc/news.scm @@ -13,7 +13,7 @@ ;; Copyright © 2021 Leo Famulari <leo@famulari.name> ;; Copyright © 2021 Zhu Zihao <all_but_last@163.com> ;; Copyright © 2021 Chris Marusich <cmmarusich@gmail.com> -;; Copyright © 2021 Maxime Devos <maximedevos@telenet.be> +;; Copyright © 2021, 2022 Maxime Devos <maximedevos@telenet.be> ;; Copyright © 2021 Xinglu Chen <public@yoctocell.xyz> ;; Copyright © 2021 Andrew Tropin <andrew@trop.in> ;; Copyright © 2021 Jonathan Brielmaier <jonathan.brielmaier@web.de> @@ -25,6 +25,167 @@ (channel-news (version 0) + (entry (commit "35c1edb20ad07250728d3bdcd0296bd0cedaf6bb") + (title + (en "New @command{edit} sub-commands for services") + (de "Neue @command{edit}-Unterbefehle für Dienste") + (fr "Nouvelles commandes @command{edit} pour les services") + (nl "Nieuwe deelopdracht @command{edit} voor diensten")) + (body + (en "The new @command{guix system edit} and @command{guix home edit} commands +allow you to view or edit service types defined for Guix System or Guix Home. +For example, here is how you would open the definition of the OpenSSH system +service: + +@example +guix system edit openssh +@end example + +Run @command{info \"(guix) Invoking guix system\"} or @command{info \"(guix) +Invoking guix home\"} for more info.") + (de "Mit den neuen Befehlen @command{guix system edit} und +@command{guix home edit} können Sie Diensttypen für Guix System oder Guix Home +betrachten und bearbeiten. Zum Beispiel würden Sie die Definition des +OpenSSH-Systemdienstes wie folgt öffnen: + +@example +guix system edit openssh +@end example + +Führen Sie @command{info \"(guix.de) Aufruf von guix system\"} oder +@command{info \"(guix.de) Aufruf von guix home\"} aus, um mehr zu erfahren.") + (fr "Les nouvelles commandes @command{guix system edit} et +@command{guix home edit} permettent de visualiser ou d'éditer les types de +services définis pour Guix System ou Guix Home. Par exemple, voici comment +ouvrir la définition du service système OpenSSH : + +@example +guix system edit openssh +@end example + +Lancer @command{info \"(guix.fr) Invoquer guix system\"} ou @command{info +\"(guix.fr) Invoquer guix home\"} pour plus d'informations.") + ;; TODO: pas verwijzingen naar de handleiding aan wanneer ze vertaald is + (nl "Met de nieuwe bewerkingen @command{guix system edit} en +@command{guix home edit} kan je dienstsoorten van Guix System en Guix +Home bekijken en bewerken. Je kan bijvoorbeeld de definitie van de +systeemdienst OpenSSH als volgt openen: + +@example +guix system edit openssh +@end example + +Voer @command{info \"(guix) Invoking guix system\"} of @command{info +\"(guix)Invoking guix home\"} uit voor meer informatie."))) + + (entry (commit "903c82583e1cec4c9ff09d5895c5cc646c37b661") + (title + (en "New @command{guix import elm} command") + (de "Neuer Befehl @command{guix import elm}") + (fr "Nouvelle commande @command{guix import elm}")) + (body + (en "The new @command{guix import elm} command allows packagers to +generate a package definition or given the name of a package for Elm, a +functional programming language for the Web: + +@example +guix import elm elm/bytes +@end example + +Run @command{info \"(guix) Invoking guix import\"} for more info. + +This comes with a new build system for Elm packages---run @command{info +\"(guix) Build Systems\"} for details.") + (de "Mit dem neuen Befehl @command{guix import elm} können Paketautoren +eine Paketdefinition anhand des Namens eines Pakets für Elm, einer funktionalen +Programmiersprache für das Web, erzeugen: + +@example +guix import elm elm/bytes +@end example + +Führen Sie @command{info \"(guix.de) Aufruf von guix import\"} aus, um mehr +Informationen zu bekommen. + +Dazu kommt ein neues Erstellungssystem für Elm-Pakete. Führen Sie +@command{info \"(guix.de) Erstellungssysteme\"} aus, um mehr zu erfahren.") + (fr "La nouvelle commande @command{guix import elm} permet de générer +une définition de paquet reposant sur Elm, un langage de programmation +fonctionnelle pour le Web: + +@example +guix import elm elm/bytes +@end example + +Lancer @command{info \"(guix.fr) Invoquer guix import\"} pour plus +d'informations. + +Cela vient avec un nouveau système de construction pour paquets Elm---lancer +@command{info \"(guix.fr) Systèmes de construction\"} pour plus de détails."))) + + (entry (commit "b6b2de2a0d52530bc1ee128c61580bed662ee15c") + (title (en "Linux-libre kernel updated to 5.17") + (de "Linux-libre-Kernel wird auf 5.17 aktualisiert")) + (body + (en "The default version of the linux-libre kernel has been + updated to the 5.17 release series.") + (de "Der standardmäßig verwendete @code{linux-libre}-Kernel basiert +jetzt auf der 5.17-Versionsreihe."))) + + (entry (commit "c42b7baf13c7633b4512e94da7445299c57b247d") + (title + (en "New @option{--export-manifest} option for @command{guix shell}") + (de "Neue Option @option{--export-manifest} für @command{guix shell}") + (fr "Nouvelle option @option{--export-manifest} de @command{guix shell}")) + (body + (en "If you use @command{guix shell}, you might wonder how to +``translate'' a command line into a manifest file that you can keep under +version control, share with others, and pass to @command{guix shell -m} and in +fact to most @command{guix} commands. This is what the new +@option{--export-manifest} option does. + +For example, the command below prints a manifest for the given packages: + +@lisp +guix shell --export-manifest \\ + -D guile git emacs emacs-geiser emacs-geiser-guile +@end lisp + +Run @code{info \"(guix) Invoking guix shell\"} for more information.") + (de "Wenn Sie @command{guix shell} benutzen, haben Sie sich vielleicht +einmal gefragt, wie Sie eine Befehlszeile in eine Manifest-Datei „übersetzen“ +können, die Sie unter Versionskontrolle stellen können, mit anderen teilen +können und an @command{guix shell -m} oder tatsächlich die meisten anderen +@command{guix}-Befehle übergeben können. Die Antwort ist die neue +Befehlszeilenoption @option{--export-manifest}. + +Zum Beispiel gibt der folgende Befehl ein Manifest mit den genannten Paketen +aus: + +@lisp +guix shell --export-manifest \\ + -D guile git emacs emacs-geiser emacs-geiser-guile +@end lisp + +Führen Sie @command{info \"(guix.de) Aufruf von guix shell\"} aus, um mehr +zu erfahren.") + (fr "Si tu utilises @command{guix shell}, tu t'es peut-être déjà +demandé comment « traduire » une ligne de commande en un fichier manifeste que +tu puisse garder en gestion de version, partager et passer à @command{guix +shell -m} et autres commandes @command{guix}. C'est ce que la nouvelle option +@option{--export-manifest} fait. + +Par exemple, la commande ci-dessous affiche un manifeste pour les paquets +donnés : + +@lisp +guix shell --export-manifest \\ + -D guile git emacs emacs-geiser emacs-geiser-guile +@end lisp + +Lancer @code{info \"(guix.fr) Invoquer guix shell\"} pour plus +d'informations."))) + (entry (commit "094a2cfbe45c104d0da30ff9d975d052ca0c118c") (title (en "New @command{guix home container} command") diff --git a/etc/release-manifest.scm b/etc/release-manifest.scm index e7e64efda4..dd70068490 100644 --- a/etc/release-manifest.scm +++ b/etc/release-manifest.scm @@ -23,7 +23,7 @@ (use-modules (gnu packages) (guix packages) (guix profiles) - ((gnu ci) #:select (%cross-targets)) + ((guix platform) #:select (targets)) ((gnu services xorg) #:select (%default-xorg-modules)) (guix utils) (srfi srfi-1) @@ -144,7 +144,7 @@ TARGET." %packages-to-cross-build))) ;; XXX: Important bits like libsigsegv and libffi don't support ;; RISCV at the moment, so don't require RISCV support. - (delete "riscv64-linux-gnu" %cross-targets)))) + (delete "riscv64-linux-gnu" (targets))))) (define %cross-bootstrap-manifest (manifest diff --git a/etc/snippets/text-mode/guix-commit-message-remove-package b/etc/snippets/text-mode/guix-commit-message-remove-package new file mode 100644 index 0000000000..0c1050f4fe --- /dev/null +++ b/etc/snippets/text-mode/guix-commit-message-remove-package @@ -0,0 +1,13 @@ +# -*- mode: snippet -*- +# name: guix-commit-message-remove-package +# key: remove +# condition: git-commit-mode +# -- +gnu: Remove ${1:`(with-temp-buffer + (magit-git-wash #'magit-diff-wash-diffs + "diff" "--staged") + (goto-char (point-min)) + (when (re-search-forward "\\-(define-public \\(\\S-+\\)" nil 'noerror) + (match-string-no-properties 1)))`}. + +* `(car (magit-staged-files))` ($1): Delete variable. diff --git a/etc/system-tests.scm b/etc/system-tests.scm index 1085deed24..de6f592dee 100644 --- a/etc/system-tests.scm +++ b/etc/system-tests.scm @@ -18,6 +18,8 @@ (use-modules (gnu tests) (gnu packages package-management) + (guix monads) + (guix store) ((gnu ci) #:select (channel-source->package)) ((guix git-download) #:select (git-predicate)) ((guix utils) #:select (current-source-directory)) @@ -41,6 +43,21 @@ determined." (repository-close! repository)) #f)))) +(define-syntax mparameterize + (syntax-rules () + "This form implements dynamic scoping, similar to 'parameterize', but in a +monadic context." + ((_ monad ((parameter value) rest ...) body ...) + (let ((old-value (parameter))) + (mbegin monad + ;; XXX: Non-local exits are not correctly handled. + (return (parameter value)) + (mlet monad ((result (mparameterize monad (rest ...) body ...))) + (parameter old-value) + (return result))))) + ((_ monad () body ...) + (mbegin monad body ...)))) + (define (tests-for-current-guix source commit) "Return a list of tests for perform, using Guix built from SOURCE, a channel instance." @@ -48,15 +65,19 @@ instance." ;; of tests to run in the usual way: ;; ;; make check-system TESTS=installed-os - (parameterize ((current-guix-package - (channel-source->package source #:commit commit))) - (match (getenv "TESTS") - (#f - (all-system-tests)) - ((= string-tokenize (tests ...)) - (filter (lambda (test) - (member (system-test-name test) tests)) - (all-system-tests)))))) + (let ((guix (channel-source->package source #:commit commit))) + (map (lambda (test) + (system-test + (inherit test) + (value (mparameterize %store-monad ((current-guix-package guix)) + (system-test-value test))))) + (match (getenv "TESTS") + (#f + (all-system-tests)) + ((= string-tokenize (tests ...)) + (filter (lambda (test) + (member (system-test-name test) tests)) + (all-system-tests))))))) (define (system-test->manifest-entry test) "Return a manifest entry for TEST, a system test." |