summaryrefslogtreecommitdiff
path: root/guix
diff options
context:
space:
mode:
authorMark H Weaver <mhw@netris.org>2016-01-19 00:18:37 -0500
committerMark H Weaver <mhw@netris.org>2016-01-19 00:18:37 -0500
commitafe9f409491a055e5d058c8f747e80d1506391e5 (patch)
tree3b3747c9d2df32019a46b283b94f0a7af05ebf1d /guix
parentbb8afbf5a1fbc85f700c0e07ce5581637e3674dc (diff)
parent1348185ac2bb48b373495830267cff8ddc6b1fa5 (diff)
Merge branch 'master' into core-updates
Diffstat (limited to 'guix')
-rw-r--r--guix/import/cran.scm11
-rw-r--r--guix/import/gem.scm3
-rw-r--r--guix/import/utils.scm14
-rw-r--r--guix/scripts/system.scm85
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