gnu: libdvdcss: Update to 1.4.3.

[jackhill/guix/guix.git] / guix / search-paths.scm

diff --git a/guix/search-paths.scm b/guix/search-paths.scm
index ee7e9a1..002e634 100644 (file)
--- a/guix/search-paths.scm
+++ b/guix/search-paths.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2013, 2014, 2015 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2013, 2014, 2015, 2017, 2018 Ludovic Courtès <ludo@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -35,9 +35,11 @@
 
             search-path-specification->sexp
             sexp->search-path-specification
+            string-tokenize*
             evaluate-search-paths
             environment-variable-definition
-            search-path-definition))
+            search-path-definition
+            set-search-paths))
 
 ;;; Commentary:
 ;;;
@@ -54,7 +56,7 @@
   search-path-specification?
   (variable     search-path-specification-variable) ;string
   (files        search-path-specification-files)    ;list of strings
-  (separator    search-path-specification-separator ;string
+  (separator    search-path-specification-separator ;string | #f
                 (default ":"))
   (file-type    search-path-specification-file-type ;symbol
                 (default 'directory))
@@ -130,20 +132,26 @@ like `string-tokenize', but SEPARATOR is a string."
 DIRECTORIES, a list of directory names, and return a list of
 specification/value pairs.  Use GETENV to determine the current settings and
 report only settings not already effective."
-  (define search-path-definition
-    (match-lambda
-      ((and spec
-            ($ <search-path-specification> variable files separator
-                                           type pattern))
+  (define (search-path-definition spec)
+    (match spec
+      (($ <search-path-specification> variable files #f type pattern)
+       ;; Separator is #f so return the first match.
+       (match (with-null-error-port
+               (search-path-as-list files directories
+                                    #:type type
+                                    #:pattern pattern))
+         (()
+          #f)
+         ((head . _)
+          (let ((value (getenv variable)))
+            (if (and value (string=? value head))
+                #f                         ;VARIABLE already set appropriately
+                (cons spec head))))))
+      (($ <search-path-specification> variable files separator
+                                      type pattern)
        (let* ((values (or (and=> (getenv variable)
                                  (cut string-tokenize* <> separator))
                           '()))
-              ;; Add a trailing slash to force symlinks to be treated as
-              ;; directories when 'find-files' traverses them.
-              (files  (if pattern
-                          (map (cut string-append <> "/") files)
-                          files))
-
               ;; XXX: Silence 'find-files' when it stumbles upon non-existent
               ;; directories (see
               ;; <http://lists.gnu.org/archive/html/guix-devel/2015-01/msg00269.html>.)
@@ -169,7 +177,7 @@ current value), or 'suffix (return the definition where VALUE is added as a
 suffix to VARIABLE's current value.)  In the case of 'prefix and 'suffix,
 SEPARATOR is used as the separator between VARIABLE's current value and its
 prefix/suffix."
-  (match kind
+  (match (if (not separator) 'exact kind)
     ('exact
      (format #f "export ~a=\"~a\"" variable value))
     ('prefix
@@ -189,4 +197,14 @@ prefix/suffix."
                                       #:kind kind
                                       #:separator separator))))
 
+(define* (set-search-paths search-paths directories
+                           #:key (setenv setenv))
+  "Set the search path environment variables specified by SEARCH-PATHS for the
+given directories."
+  (for-each (match-lambda
+              ((spec . value)
+               (setenv (search-path-specification-variable spec)
+                       value)))
+            (evaluate-search-paths search-paths directories)))
+
 ;;; search-paths.scm ends here