From 2028a2c9607b407d3686ca5791c604ddec45f8f8 Mon Sep 17 00:00:00 2001 From: Ben Woodcroft Date: Wed, 6 Jan 2016 00:09:19 +1000 Subject: import: cran: Move beautify-description to utils module. * guix/import/cran.scm (beautify-description): Move from here... * guix/import/utils.scm: ... to here. --- guix/import/cran.scm | 11 ----------- guix/import/utils.scm | 14 +++++++++++++- 2 files changed, 13 insertions(+), 12 deletions(-) (limited to 'guix') 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/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))) -- cgit v1.2.3 From 869cda545d67ff342924780c045ff1c4efa2fd06 Mon Sep 17 00:00:00 2001 From: Ben Woodcroft Date: Wed, 6 Jan 2016 00:17:36 +1000 Subject: import: gem: Beautify description field. * guix/import/gem.scm (gem->guix-package): Use 'beautify-description'. --- guix/import/gem.scm | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) (limited to 'guix') 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"))) -- cgit v1.2.3 From b8300494c0cef32d7398aee705c9271346d0290e Mon Sep 17 00:00:00 2001 From: Alex Kost Date: Fri, 8 Jan 2016 02:48:17 +0300 Subject: Move to (gnu system). * guix/scripts/system.scm (previous-grub-entries) (display-system-generation): Use accessors instead of matching . (boot-parameters, boot-parameters?, boot-parameters-label) (boot-parameters-root-device, boot-parameters-kernel) (boot-parameters-kernel-arguments, read-boot-parameters): Move to... * gnu/system.scm: ... here. Export them. --- gnu/system.scm | 41 ++++++++++++++++++++++++ guix/scripts/system.scm | 85 ++++++++++++++++--------------------------------- 2 files changed, 68 insertions(+), 58 deletions(-) (limited to 'guix') diff --git a/gnu/system.scm b/gnu/system.scm index 4aedb7ee36..ee0280c069 100644 --- a/gnu/system.scm +++ b/gnu/system.scm @@ -88,6 +88,14 @@ operating-system-locale-directory operating-system-boot-script + boot-parameters + boot-parameters? + boot-parameters-label + boot-parameters-root-device + boot-parameters-kernel + boot-parameters-kernel-arguments + read-boot-parameters + local-host-aliases %setuid-programs %base-packages @@ -709,4 +717,37 @@ this file is the reconstruction of GRUB menu entries for old configurations." #$(operating-system-kernel-arguments os)) (initrd #$initrd))))) + +;;; +;;; Boot parameters +;;; + +(define-record-type* + 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 + 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))) + ;;; system.scm ends here 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 +;;; Copyright © 2016 Alex Kost ;;; ;;; This file is part of GNU Guix. ;;; @@ -189,39 +190,6 @@ the ownership of '~a' may be incorrect!~%") (mwhen grub? (install-grub* grub.cfg device target))))) - -;;; -;;; Boot parameters -;;; - -(define-record-type* - 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 - 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) - (($ 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 - (($ 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 -- cgit v1.2.3