diff options
author | Mark H Weaver <mhw@netris.org> | 2016-01-19 00:18:37 -0500 |
---|---|---|
committer | Mark H Weaver <mhw@netris.org> | 2016-01-19 00:18:37 -0500 |
commit | afe9f409491a055e5d058c8f747e80d1506391e5 (patch) | |
tree | 3b3747c9d2df32019a46b283b94f0a7af05ebf1d /guix | |
parent | bb8afbf5a1fbc85f700c0e07ce5581637e3674dc (diff) | |
parent | 1348185ac2bb48b373495830267cff8ddc6b1fa5 (diff) |
Merge branch 'master' into core-updates
Diffstat (limited to 'guix')
-rw-r--r-- | guix/import/cran.scm | 11 | ||||
-rw-r--r-- | guix/import/gem.scm | 3 | ||||
-rw-r--r-- | guix/import/utils.scm | 14 | ||||
-rw-r--r-- | guix/scripts/system.scm | 85 |
4 files changed, 42 insertions, 71 deletions
diff --git a/guix/import/cran.scm b/guix/import/cran.scm index fc2709020a..1c30da89c7 100644 --- a/guix/import/cran.scm +++ b/guix/import/cran.scm @@ -136,17 +136,6 @@ empty list when the FIELD cannot be found." (string-any char-set:whitespace item))) (map string-trim-both items)))))) -(define (beautify-description description) - "Improve the package DESCRIPTION by turning a beginning sentence fragment -into a proper sentence and by using two spaces between sentences." - (let ((cleaned (if (string-prefix? "A " description) - (string-append "This package provides a" - (substring description 1)) - description))) - ;; Use double spacing between sentences - (regexp-substitute/global #f "\\. \\b" - cleaned 'pre ". " 'post))) - (define (description->package meta) "Return the `package' s-expression for a CRAN package from the alist META, which was derived from the R package's DESCRIPTION file." diff --git a/guix/import/gem.scm b/guix/import/gem.scm index c64c4e9374..3c42052f1a 100644 --- a/guix/import/gem.scm +++ b/guix/import/gem.scm @@ -117,7 +117,8 @@ VERSION, HASH, HOME-PAGE, DESCRIPTION, DEPENDENCIES, and LICENSES." (let ((name (assoc-ref package "name")) (version (assoc-ref package "version")) (hash (assoc-ref package "sha")) - (description (assoc-ref package "info")) + (description (beautify-description + (assoc-ref package "info"))) (home-page (assoc-ref package "homepage_uri")) (dependencies (map (lambda (dep) (let ((name (assoc-ref dep "name"))) diff --git a/guix/import/utils.scm b/guix/import/utils.scm index 0734fa1230..44e004b084 100644 --- a/guix/import/utils.scm +++ b/guix/import/utils.scm @@ -37,7 +37,8 @@ string->license license->symbol - snake-case)) + snake-case + beautify-description)) (define (factorize-uri uri version) "Factorize URI, a package tarball URI as a string, such that any occurrences @@ -136,3 +137,14 @@ to in the (guix licenses) module, or #f if there is no such known license." "Return a downcased version of the string STR where underscores are replaced with dashes." (string-join (string-split (string-downcase str) #\_) "-")) + +(define (beautify-description description) + "Improve the package DESCRIPTION by turning a beginning sentence fragment +into a proper sentence and by using two spaces between sentences." + (let ((cleaned (if (string-prefix? "A " description) + (string-append "This package provides a" + (substring description 1)) + description))) + ;; Use double spacing between sentences + (regexp-substitute/global #f "\\. \\b" + cleaned 'pre ". " 'post))) diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm index 1407dc73fa..564ed02d59 100644 --- a/guix/scripts/system.scm +++ b/guix/scripts/system.scm @@ -1,5 +1,6 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2014, 2015 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2016 Alex Kost <alezost@gmail.com> ;;; ;;; This file is part of GNU Guix. ;;; @@ -191,39 +192,6 @@ the ownership of '~a' may be incorrect!~%") ;;; -;;; Boot parameters -;;; - -(define-record-type* <boot-parameters> - boot-parameters make-boot-parameters boot-parameters? - (label boot-parameters-label) - (root-device boot-parameters-root-device) - (kernel boot-parameters-kernel) - (kernel-arguments boot-parameters-kernel-arguments)) - -(define (read-boot-parameters port) - "Read boot parameters from PORT and return the corresponding -<boot-parameters> object or #f if the format is unrecognized." - (match (read port) - (('boot-parameters ('version 0) - ('label label) ('root-device root) - ('kernel linux) - rest ...) - (boot-parameters - (label label) - (root-device root) - (kernel linux) - (kernel-arguments - (match (assq 'kernel-arguments rest) - ((_ args) args) - (#f '()))))) ;the old format - (x ;unsupported format - (warning (_ "unrecognized boot parameters for '~a'~%") - system) - #f))) - - -;;; ;;; Reconfiguration. ;;; @@ -285,22 +253,24 @@ it atomically, and then run OS's activation script." "Return a list of 'menu-entry' for the generations of PROFILE." (define (system->grub-entry system number time) (unless-file-not-found - (let ((file (string-append system "/parameters"))) - (match (call-with-input-file file read-boot-parameters) - (($ <boot-parameters> label root kernel kernel-arguments) - (menu-entry - (label (string-append label " (#" - (number->string number) ", " - (seconds->string time) ")")) - (linux kernel) - (linux-arguments - (cons* (string-append "--root=" root) - #~(string-append "--system=" #$system) - #~(string-append "--load=" #$system "/boot") - kernel-arguments)) - (initrd #~(string-append #$system "/initrd")))) - (#f ;invalid format - #f))))) + (let* ((file (string-append system "/parameters")) + (params (call-with-input-file file + read-boot-parameters)) + (label (boot-parameters-label params)) + (root (boot-parameters-root-device params)) + (kernel (boot-parameters-kernel params)) + (kernel-arguments (boot-parameters-kernel-arguments params))) + (menu-entry + (label (string-append label " (#" + (number->string number) ", " + (seconds->string time) ")")) + (linux kernel) + (linux-arguments + (cons* (string-append "--root=" root) + #~(string-append "--system=" #$system) + #~(string-append "--load=" #$system "/boot") + kernel-arguments)) + (initrd #~(string-append #$system "/initrd")))))) (let* ((numbers (generation-numbers profile)) (systems (map (cut generation-file-name profile <>) @@ -366,18 +336,17 @@ list of services." (unless (zero? number) (let* ((generation (generation-file-name profile number)) (param-file (string-append generation "/parameters")) - (params (call-with-input-file param-file read-boot-parameters))) + (params (call-with-input-file param-file read-boot-parameters)) + (label (boot-parameters-label params)) + (root (boot-parameters-root-device params)) + (kernel (boot-parameters-kernel params))) (display-generation profile number) (format #t (_ " file name: ~a~%") generation) (format #t (_ " canonical file name: ~a~%") (readlink* generation)) - (match params - (($ <boot-parameters> label root kernel) - ;; TRANSLATORS: Please preserve the two-space indentation. - (format #t (_ " label: ~a~%") label) - (format #t (_ " root device: ~a~%") root) - (format #t (_ " kernel: ~a~%") kernel)) - (_ - #f))))) + ;; TRANSLATORS: Please preserve the two-space indentation. + (format #t (_ " label: ~a~%") label) + (format #t (_ " root device: ~a~%") root) + (format #t (_ " kernel: ~a~%") kernel)))) (define* (list-generations pattern #:optional (profile %system-profile)) "Display in a human-readable format all the system generations matching |