utils: Add 'strip-store-file-name'.

* guix/build/utils.scm (strip-store-file-name): New procedure.
* guix/build/emacs-build-system.scm (store-directory->name-version):
  Remove.  Update callers to use 'strip-store-file-name'.
* gnu/packages/gcc.scm (make-libstdc++-doc)[arguments]: Use
  'strip-store-file-name' instead of 'string-drop'.
This commit is contained in:
Ludovic Courtès 2015-08-30 14:38:10 +02:00
parent d56f8d5e74
commit b7c7c03eb5
3 changed files with 13 additions and 17 deletions

View file

@ -578,11 +578,7 @@ (define (make-libstdc++-doc gcc)
(("@XSL_STYLE_DIR@") (("@XSL_STYLE_DIR@")
(string-append (string-append
docbook "/xml/xsl/" docbook "/xml/xsl/"
(string-drop (strip-store-file-name docbook)))))))
docbook
(+ 34
(string-length
(%store-directory))))))))))
(replace 'build (replace 'build
(lambda _ (lambda _
;; XXX: There's also a 'doc-info' target, but it ;; XXX: There's also a 'doc-info' target, but it

View file

@ -83,7 +83,7 @@ (define* (move-doc #:key outputs #:allow-other-keys)
(let* ((out (assoc-ref outputs "out")) (let* ((out (assoc-ref outputs "out"))
(elpa-name-ver (store-directory->elpa-name-version out)) (elpa-name-ver (store-directory->elpa-name-version out))
(el-dir (string-append out %install-suffix "/" elpa-name-ver)) (el-dir (string-append out %install-suffix "/" elpa-name-ver))
(name-ver (store-directory->name-version out)) (name-ver (strip-store-file-name out))
(info-dir (string-append out "/share/info/" name-ver)) (info-dir (string-append out "/share/info/" name-ver))
(info-files (find-files el-dir "\\.info$"))) (info-files (find-files el-dir "\\.info$")))
(unless (null? info-files) (unless (null? info-files)
@ -116,7 +116,7 @@ (define (emacs-inputs inputs)
(filter (match-lambda (filter (match-lambda
((label . directory) ((label . directory)
(emacs-package? ((compose package-name->name+version (emacs-package? ((compose package-name->name+version
store-directory->name-version) strip-store-file-name)
directory))) directory)))
(_ #f)) (_ #f))
inputs)) inputs))
@ -138,25 +138,18 @@ (define (emacs-inputs-el-directories dirs)
(define (package-name-version->elpa-name-version name-ver) (define (package-name-version->elpa-name-version name-ver)
"Convert the Guix package NAME-VER to the corresponding ELPA name-version "Convert the Guix package NAME-VER to the corresponding ELPA name-version
format. Essnetially drop the prefix used in Guix." format. Essnetially drop the prefix used in Guix."
(let ((name (store-directory->name-version name-ver))) (let ((name (strip-store-file-name name-ver)))
(if (emacs-package? name-ver) (if (emacs-package? name-ver)
(store-directory->name-version name-ver) (strip-store-file-name name-ver)
name-ver))) name-ver)))
(define (store-directory->elpa-name-version store-dir) (define (store-directory->elpa-name-version store-dir)
"Given a store directory STORE-DIR return the part of the basename after the "Given a store directory STORE-DIR return the part of the basename after the
second hyphen. This corresponds to 'name-version' as used in ELPA packages." second hyphen. This corresponds to 'name-version' as used in ELPA packages."
((compose package-name-version->elpa-name-version ((compose package-name-version->elpa-name-version
store-directory->name-version) strip-store-file-name)
store-dir)) store-dir))
(define (store-directory->name-version store-dir)
"Given a store directory STORE-DIR return the part of the basename
after the first hyphen. This corresponds to 'name-version' of the package."
(let* ((base (basename store-dir)))
(string-drop base
(+ 1 (string-index base #\-)))))
;; from (guix utils). Should we put it in (guix build utils)? ;; from (guix utils). Should we put it in (guix build utils)?
(define (package-name->name+version name) (define (package-name->name+version name)
"Given NAME, a package name like \"foo-0.9.1b\", return two values: "Given NAME, a package name like \"foo-0.9.1b\", return two values:

View file

@ -33,6 +33,7 @@ (define-module (guix build utils)
alist-delete) alist-delete)
#:export (%store-directory #:export (%store-directory
store-file-name? store-file-name?
strip-store-file-name
parallel-job-count parallel-job-count
directory-exists? directory-exists?
@ -87,6 +88,12 @@ (define (store-file-name? file)
"Return true if FILE is in the store." "Return true if FILE is in the store."
(string-prefix? (%store-directory) file)) (string-prefix? (%store-directory) file))
(define (strip-store-file-name file)
"Strip the '/gnu/store' and hash from FILE, a store file name. The result
is typically a \"PACKAGE-VERSION\" string."
(string-drop file
(+ 34 (string-length (%store-directory)))))
(define parallel-job-count (define parallel-job-count
;; Number of processes to be passed next to GNU Make's `-j' argument. ;; Number of processes to be passed next to GNU Make's `-j' argument.
(make-parameter (make-parameter