processes: Allow 'less' to properly estimate line length.

[jackhill/guix/guix.git] / guix / profiles.scm

diff --git a/guix/profiles.scm b/guix/profiles.scm
index b3a3db0..0619e73 100644 (file)
--- a/guix/profiles.scm
+++ b/guix/profiles.scm
@@ -32,6 +32,7 @@
   #:use-module ((guix utils) #:hide (package-name->name+version))
   #:use-module ((guix build utils)
                 #:select (package-name->name+version mkdir-p))
+  #:use-module ((guix diagnostics) #:select (&fix-hint))
   #:use-module (guix i18n)
   #:use-module (guix records)
   #:use-module (guix packages)
@@ -41,7 +42,6 @@
   #:use-module (guix modules)
   #:use-module (guix monads)
   #:use-module (guix store)
-  #:use-module (guix sets)
   #:use-module (ice-9 vlist)
   #:use-module (ice-9 match)
   #:use-module (ice-9 regex)
@@ -105,6 +105,7 @@
             manifest-installed?
             manifest-matching-entries
             manifest-search-paths
+            check-for-collisions
 
             manifest-transaction
             manifest-transaction?
@@ -260,17 +261,17 @@ field."
 recursively."
   (let loop ((entries (manifest-entries manifest))
              (result  '())
-             (visited (set)))                     ;compare with 'equal?'
+             (visited vlist-null))            ;compare with 'manifest-entry=?'
     (match entries
       (()
        (reverse result))
       ((head . tail)
-       (if (set-contains? visited head)
+       (if (vhash-assoc head visited manifest-entry=?)
            (loop tail result visited)
            (loop (append (manifest-entry-dependencies head)
                          tail)
                  (cons head result)
-                 (set-insert head visited)))))))
+                 (vhash-cons head #t visited)))))))
 
 (define (profile-manifest profile)
   "Return the PROFILE's manifest."
@@ -1171,6 +1172,8 @@ for both major versions of GTK+."
     ;; Don't run the hook when there's nothing to do.
     (let* ((pkg-gtk+ (module-ref        ; lazy reference
                       (resolve-interface '(gnu packages gtk)) 'gtk+))
+           (pkg-gtk+2 (module-ref        ; lazy reference
+                       (resolve-interface '(gnu packages gtk)) 'gtk+-2))
            (gexp #~(begin
                      #$(if gtk+
                            (build
@@ -1184,7 +1187,7 @@ for both major versions of GTK+."
                            (build
                             gtk+-2 "2.10.0"
                             #~(string-append
-                               #$gtk+-2 "/bin/gtk-query-immodules-2.0"))
+                               #$pkg-gtk+2:bin "/bin/gtk-query-immodules-2.0"))
                            #t))))
       (if (or gtk+ gtk+-2)
           (gexp->derivation "gtk-im-modules" gexp
@@ -1200,17 +1203,18 @@ for both major versions of GTK+."
 and creates the dependency graph of all these kernel modules.
 
 This is meant to be used as a profile hook."
-  (define kmod  ; lazy reference
+  (define kmod                                    ; lazy reference
     (module-ref (resolve-interface '(gnu packages linux)) 'kmod))
   (define build
-     (with-imported-modules
-     (source-module-closure '((guix build utils)
+    (with-imported-modules (source-module-closure
+                            '((guix build utils)
                               (gnu build linux-modules)))
       #~(begin
           (use-modules (ice-9 ftw)
                        (ice-9 match)
-                       (srfi srfi-1) ; append-map
+                       (srfi srfi-1)              ; append-map
                        (gnu build linux-modules))
+
           (let* ((inputs '#$(manifest-inputs manifest))
                  (module-directories
                   (map (lambda (directory)
@@ -1218,20 +1222,25 @@ This is meant to be used as a profile hook."
                        inputs))
                  (directory-entries
                   (lambda (directory)
-                    (scandir directory (lambda (basename)
-                                         (not
-                                           (string-prefix? "." basename))))))
+                    (or (scandir directory
+                                 (lambda (basename)
+                                   (not (string-prefix? "." basename))))
+                        '())))
                  ;; Note: Should usually result in one entry.
                  (versions (delete-duplicates
                             (append-map directory-entries
                                         module-directories))))
-              (match versions
-               ((version)
-                (let ((old-path (getenv "PATH")))
-                  (setenv "PATH" #+(file-append kmod "/bin"))
-                  (make-linux-module-directory inputs version #$output)
-                  (setenv "PATH" old-path)))
-               (_ (error "Specified Linux kernel and Linux kernel modules
+            (match versions
+              ((version)
+               (let ((old-path (getenv "PATH")))
+                 (setenv "PATH" #+(file-append kmod "/bin"))
+                 (make-linux-module-directory inputs version #$output)
+                 (setenv "PATH" old-path)))
+              (()
+               ;; Nothing here, maybe because this is a kernel with
+               ;; CONFIG_MODULES=n.
+               (mkdir #$output))
+              (_ (error "Specified Linux kernel and Linux kernel modules
 are not all of the same version")))))))
   (gexp->derivation "linux-module-database" build
                     #:local-build? #t
@@ -1625,8 +1634,10 @@ are cross-built for TARGET."
                          (guix search-paths)
                          (srfi srfi-1))
 
-            (setvbuf (current-output-port) _IOLBF)
-            (setvbuf (current-error-port) _IOLBF)
+            (let ((line (cond-expand (guile-2.2 'line)
+                                     (else _IOLBF)))) ;Guile 2.0
+              (setvbuf (current-output-port) line)
+              (setvbuf (current-error-port) line))
 
             #+(if locales? set-utf8-locale #t)