From d326767e6417cbaad2856e6641e98dd80311b8c3 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Sun, 11 Jan 2015 23:43:30 +0100 Subject: Add (guix sets). * guix/sets.scm, tests/sets.scm: New files.sets * Makefile.am (MODULES, SCM_TESTS): Add them. --- Makefile.am | 4 +- guix/sets.scm | 116 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++ tests/sets.scm | 52 ++++++++++++++++++++++++++ 3 files changed, 171 insertions(+), 1 deletion(-) create mode 100644 guix/sets.scm create mode 100644 tests/sets.scm diff --git a/Makefile.am b/Makefile.am index 5ee743470b..c482848fdf 100644 --- a/Makefile.am +++ b/Makefile.am @@ -1,5 +1,5 @@ # GNU Guix --- Functional package management for GNU -# Copyright © 2012, 2013, 2014 Ludovic Courtès +# Copyright © 2012, 2013, 2014, 2015 Ludovic Courtès # Copyright © 2013 Andreas Enge # # This file is part of GNU Guix. @@ -34,6 +34,7 @@ MODULES = \ guix/pk-crypto.scm \ guix/pki.scm \ guix/utils.scm \ + guix/sets.scm \ guix/download.scm \ guix/git-download.scm \ guix/monads.scm \ @@ -153,6 +154,7 @@ SCM_TESTS = \ tests/hash.scm \ tests/pk-crypto.scm \ tests/pki.scm \ + tests/sets.scm \ tests/substitute-binary.scm \ tests/builders.scm \ tests/derivations.scm \ diff --git a/guix/sets.scm b/guix/sets.scm new file mode 100644 index 0000000000..017b79ca31 --- /dev/null +++ b/guix/sets.scm @@ -0,0 +1,116 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2015 Ludovic Courtès +;;; +;;; This file is part of GNU Guix. +;;; +;;; GNU Guix is free software; you can redistribute it and/or modify it +;;; under the terms of the GNU General Public License as published by +;;; the Free Software Foundation; either version 3 of the License, or (at +;;; your option) any later version. +;;; +;;; GNU Guix is distributed in the hope that it will be useful, but +;;; WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;;; GNU General Public License for more details. +;;; +;;; You should have received a copy of the GNU General Public License +;;; along with GNU Guix. If not, see . + +(define-module (guix sets) + #:use-module (srfi srfi-1) + #:use-module (srfi srfi-9) + #:use-module (srfi srfi-26) + #:use-module (ice-9 vlist) + #:use-module (ice-9 match) + #:export (set + setq + set? + set-insert + set-union + set-contains? + set->list + list->set + list->setq)) + +;;; Commentary: +;;; +;;; A simple (simplistic?) implementation of unordered persistent sets based +;;; on vhashes that seems to be good enough so far. +;;; +;;; Another option would be to use "bounded balance trees" (Adams 1992) as +;;; implemented by Ian Price in 'pfds', which has faster union etc. but needs +;;; an order on the objects of the set. +;;; +;;; Code: + +(define-record-type + (%make-set vhash insert ref) + set? + (vhash set-vhash) + (insert set-insert-proc) + (ref set-ref)) + +(define %insert + (cut vhash-cons <> #t <>)) +(define %insertq + (cut vhash-consq <> #t <>)) + +(define (set . args) + "Return a set containing the ARGS, compared as per 'equal?'." + (list->set args)) + +(define (setq . args) + "Return a set containing the ARGS, compared as per 'eq?'." + (list->setq args)) + +(define (list->set lst) + "Return a set with the elements taken from LST. Elements of the set will be +compared with 'equal?'." + (%make-set (fold %insert vlist-null lst) + %insert + vhash-assoc)) + +(define (list->setq lst) + "Return a set with the elements taken from LST. Elements of the set will be +compared with 'eq?'." + (%make-set (fold %insertq vlist-null lst) + %insertq + vhash-assq)) + +(define-inlinable (set-contains? set value) + "Return #t if VALUE is a member of SET." + (->bool ((set-ref set) value (set-vhash set)))) + +(define (set-insert value set) + "Insert VALUE into SET." + (if (set-contains? set value) + set + (let ((vhash ((set-insert-proc set) value (set-vhash set)))) + (%make-set vhash (set-insert-proc set) (set-ref set))))) + +(define-inlinable (set-size set) + "Return the number of elements in SET." + (vlist-length (set-vhash set))) + +(define (set-union set1 set2) + "Return the union of SET1 and SET2. Warning: this is linear in the number +of elements of the smallest." + (unless (eq? (set-insert-proc set1) (set-insert-proc set2)) + (error "set-union: incompatible sets")) + + (let* ((small (if (> (set-size set1) (set-size set2)) + set2 set1)) + (large (if (eq? small set1) set2 set1))) + (vlist-fold (match-lambda* + (((item . _) result) + (set-insert item result))) + large + (set-vhash small)))) + +(define (set->list set) + "Return the list of elements of SET." + (map (match-lambda + ((key . _) key)) + (vlist->list (set-vhash set)))) + +;;; sets.scm ends here diff --git a/tests/sets.scm b/tests/sets.scm new file mode 100644 index 0000000000..0a89591765 --- /dev/null +++ b/tests/sets.scm @@ -0,0 +1,52 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2015 Ludovic Courtès +;;; +;;; This file is part of GNU Guix. +;;; +;;; GNU Guix is free software; you can redistribute it and/or modify it +;;; under the terms of the GNU General Public License as published by +;;; the Free Software Foundation; either version 3 of the License, or (at +;;; your option) any later version. +;;; +;;; GNU Guix is distributed in the hope that it will be useful, but +;;; WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;;; GNU General Public License for more details. +;;; +;;; You should have received a copy of the GNU General Public License +;;; along with GNU Guix. If not, see . + +(define-module (test-sets) + #:use-module (guix sets) + #:use-module (srfi srfi-1) + #:use-module (srfi srfi-26) + #:use-module (srfi srfi-64)) + + +(test-begin "sets") + +(test-assert "set-contains?" + (let* ((lst (iota 123)) + (set (list->set lst))) + (and (every (cut set-contains? set <>) + lst) + (not (set-contains? set -1))))) + +(test-assert "set->list" + (let* ((lst (iota 123)) + (set (list->set lst))) + (lset= = lst (set->list set)))) + +(test-assert "set-union" + (let* ((a (list 'a)) + (b (list 'b)) + (s1 (setq a)) + (s2 (setq b)) + (s3 (set-union s1 s2))) + (and (set-contains? s3 a) + (set-contains? s3 b)))) + +(test-end) + + +(exit (= (test-runner-fail-count (test-runner-current)) 0)) -- cgit v1.2.3 From ed3592a9809fad73e9caee2d321d06446d78c8d2 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Sun, 11 Jan 2015 23:04:07 +0100 Subject: derivations: Use sets for 'derivations-prerequisites'. This yields a 46% improvement in 'derivation-prerequisites' invocations on the Emacs derivation. * guix/derivations.scm (derivation-prerequisites): Add 'input-set' variable, and use it in iterations. --- guix/derivations.scm | 21 ++++++++++++--------- 1 file changed, 12 insertions(+), 9 deletions(-) diff --git a/guix/derivations.scm b/guix/derivations.scm index ec438e833c..2f015089a3 100644 --- a/guix/derivations.scm +++ b/guix/derivations.scm @@ -31,6 +31,7 @@ (define-module (guix derivations) #:use-module (guix hash) #:use-module (guix base32) #:use-module (guix records) + #:use-module (guix sets) #:export ( derivation? derivation-outputs @@ -162,16 +163,18 @@ (define (derivation-input-output-paths input) (define (derivation-prerequisites drv) "Return the list of derivation-inputs required to build DRV, recursively." - (let loop ((drv drv) - (result '())) - (let ((inputs (remove (cut member <> result) ; XXX: quadratic + (let loop ((drv drv) + (result '()) + (input-set (set))) + (let ((inputs (remove (cut set-contains? input-set <>) (derivation-inputs drv)))) - (fold loop - (append inputs result) - (map (lambda (i) - (call-with-input-file (derivation-input-path i) - read-derivation)) - inputs))))) + (fold2 loop + (append inputs result) + (fold set-insert input-set inputs) + (map (lambda (i) + (call-with-input-file (derivation-input-path i) + read-derivation)) + inputs))))) (define (offloadable-derivation? drv) "Return true if DRV can be offloaded, false otherwise." -- cgit v1.2.3 From c06d140c03020c669ce89bdb43c06fd27abc6e69 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Sun, 11 Jan 2015 23:20:57 +0100 Subject: derivations: Use a set for 'substitution-oracle'. * guix/derivations.scm (substitution-oracle): Use sets instead of lists. --- guix/derivations.scm | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/guix/derivations.scm b/guix/derivations.scm index 2f015089a3..b48e7e604d 100644 --- a/guix/derivations.scm +++ b/guix/derivations.scm @@ -217,8 +217,8 @@ (define* (substitution-oracle store drv) (append self deps result))) '() drv))) - (subst (substitutable-paths store paths))) - (cut member <> subst))) + (subst (list->set (substitutable-paths store paths)))) + (cut set-contains? subst <>))) (define* (derivation-prerequisites-to-build store drv #:key -- cgit v1.2.3 From bbea9565759f7c5695c541f2c7e2b71f1ee7dbae Mon Sep 17 00:00:00 2001 From: Andreas Enge Date: Mon, 12 Jan 2015 13:27:59 +0100 Subject: gnu: pari-gp: Update to 2.7.2. * gnu/packages/algebra.scm (pari-gp): Update to 2.7.2. --- gnu/packages/algebra.scm | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/gnu/packages/algebra.scm b/gnu/packages/algebra.scm index b212aa67a9..c567648c74 100644 --- a/gnu/packages/algebra.scm +++ b/gnu/packages/algebra.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2012, 2013, 2014 Andreas Enge +;;; Copyright © 2012, 2013, 2014, 2015 Andreas Enge ;;; Copyright © 2013 Ludovic Courtès ;;; Copyright © 2014 Mark H Weaver ;;; @@ -83,14 +83,14 @@ (define-public fplll (define-public pari-gp (package (name "pari-gp") - (version "2.7.1") + (version "2.7.2") (source (origin (method url-fetch) (uri (string-append "http://pari.math.u-bordeaux.fr/pub/pari/unix/pari-" version ".tar.gz")) (sha256 (base32 - "1gj1rddi22hinzwy7r6hljgbi252wwwyd6gapg4hvcn0ycc7jqyc")))) + "1b0hzyhafpxhmiljyhnsh6c27ydsvb2599fshwq2fjfm96awjxmc")))) (build-system gnu-build-system) (inputs `(("gmp" ,gmp) ("perl" ,perl) -- cgit v1.2.3 From a63ffe03d44a20072d8c0b7913069737de6161bc Mon Sep 17 00:00:00 2001 From: Andreas Enge Date: Mon, 12 Jan 2015 13:31:35 +0100 Subject: gnu: gp2c: Update to 0.0.9pl2. * gnu/packages/algebra.scm (gp2c): Update to 0.0.9pl2. --- gnu/packages/algebra.scm | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/gnu/packages/algebra.scm b/gnu/packages/algebra.scm index c567648c74..2973c68675 100644 --- a/gnu/packages/algebra.scm +++ b/gnu/packages/algebra.scm @@ -123,14 +123,14 @@ (define-public pari-gp (define-public gp2c (package (name "gp2c") - (version "0.0.9pl1") + (version "0.0.9pl2") (source (origin (method url-fetch) (uri (string-append "http://pari.math.u-bordeaux.fr/pub/pari/GP2C/gp2c-" version ".tar.gz")) (sha256 (base32 - "1p36060vwhn38j77r4c3jqyaslvhvgm6fdw2486k7krxk5ai7ph5")))) + "02h35fwz1caicii7fj8zb9ky4hcrd8rqmzkyvhbls0r05yg5bwwb")))) (build-system gnu-build-system) (native-inputs `(("perl" ,perl))) (inputs `(("pari-gp" ,pari-gp))) -- cgit v1.2.3 From 7d05f769568a3051a3717b3ed0e1e484ac422aa4 Mon Sep 17 00:00:00 2001 From: Jason Self Date: Mon, 12 Jan 2015 07:59:17 -0800 Subject: gnu: ffmpeg-2.2: Update to 2.2.11 * gnu/packages/video.scm (ffmpeg-2.2): Update to version 2.2.11. --- gnu/packages/video.scm | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/gnu/packages/video.scm b/gnu/packages/video.scm index 984ba7e1f4..0d477bb7c8 100644 --- a/gnu/packages/video.scm +++ b/gnu/packages/video.scm @@ -199,14 +199,14 @@ (define-public ffmpeg ;; We need this older ffmpeg because vlc-2.1.5 doesn't work with ffmpeg-2.4. (define-public ffmpeg-2.2 (package (inherit ffmpeg) - (version "2.2.10") + (version "2.2.11") (source (origin (method url-fetch) (uri (string-append "http://www.ffmpeg.org/releases/ffmpeg-" version ".tar.bz2")) (sha256 (base32 - "14d83ijp5lxdr6nl9rqhc4598jp020paxrg64r9ifxqhbigl0yqm")))))) + "06sli7xvihh97ss6a2mkdq4dcj3rg1w8zffrmjfc1hvyjxhc8f2r")))))) (define-public vlc (package -- cgit v1.2.3 From 9f496d430bbcd3bacfc131e513a192786fb08746 Mon Sep 17 00:00:00 2001 From: Jason Self Date: Mon, 12 Jan 2015 08:00:21 -0800 Subject: gnu: ffmpeg: Update to 2.5.3 * gnu/packages/video.scm (ffmpeg): Update to version 2.5.3. --- gnu/packages/video.scm | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/gnu/packages/video.scm b/gnu/packages/video.scm index 0d477bb7c8..2febd12ff7 100644 --- a/gnu/packages/video.scm +++ b/gnu/packages/video.scm @@ -58,14 +58,14 @@ (define-module (gnu packages video) (define-public ffmpeg (package (name "ffmpeg") - (version "2.4.3") + (version "2.5.3") (source (origin (method url-fetch) (uri (string-append "http://www.ffmpeg.org/releases/ffmpeg-" version ".tar.bz2")) (sha256 (base32 - "00p6qi7kwc2rv7h98bczrdssa7nbda3fpz7avjwl77jg1qy3wp6a")))) + "06j1cgw9h9ya5z8gpcf9v9zik3l4xz7sr4wshj06kznzz5z3sf4x")))) (build-system gnu-build-system) (inputs `(("fontconfig" ,fontconfig) -- cgit v1.2.3 From 61771a79abb4a354d48469be9744f9537caefc96 Mon Sep 17 00:00:00 2001 From: Federico Beffa Date: Thu, 18 Dec 2014 20:58:18 +0100 Subject: guix: build/glib-or-gtk-build-system: Add support for GIO and XDG theming. * guix/build/glib-or-gtk-build-system.scm (data-directories): Rename 'schemas-directories' to 'data-directories' and add support for XDG theming data. * guix/build/glib-or-gtk-build-system.scm (gio-module-directories): New function. * guix/build/glib-or-gtk-build-system.scm (wrap-all-programs): Update names to reflect that we are dealing with more types of data and not only with schemas. Add handling of GIO modules. * guix/build-system/glib-or-gtk.scm (lower): Import the 'bin' output of GLib instead of 'out'. This was an error since we need the program 'glib-compile-schemas'. Update the description. --- guix/build-system/glib-or-gtk.scm | 30 ++++--- guix/build/glib-or-gtk-build-system.scm | 138 +++++++++++++++++++++++++++----- 2 files changed, 141 insertions(+), 27 deletions(-) diff --git a/guix/build-system/glib-or-gtk.scm b/guix/build-system/glib-or-gtk.scm index 8091311879..7a90587136 100644 --- a/guix/build-system/glib-or-gtk.scm +++ b/guix/build-system/glib-or-gtk.scm @@ -34,15 +34,14 @@ (define-module (guix build-system glib-or-gtk) ;; This build system is an extension of the 'gnu-build-system'. It ;; accomodates the needs of applications making use of glib or gtk+ (with "or" ;; to be interpreted in the mathematical sense). This is achieved by adding -;; two phases run after the 'install' phase: +;; three phases run after the 'install' phase: ;; ;; 'glib-or-gtk-wrap' phase: ;; -;; a) This phase looks for GSettings schemas by verifying the existence of -;; path "datadir/glib-2.0/schemas" in all input packages. If the path is -;; found in any package, then all programs in "out/bin" are wrapped in scripts -;; where the environment variable "XDG_DATA_DIRS" is set and points to the -;; list of found schemas directories. +;; a) This phase looks for GSettings schemas, GIO modules and theming data. +;; If any of these is found in any input package, then all programs in +;; "out/bin" are wrapped in scripts defining the nedessary environment +;; variables. ;; ;; b) Looks for the existence of "libdir/gtk-3.0" directories in all input ;; packages. If any is found, then the environment variable "GTK_PATH" is @@ -56,6 +55,11 @@ (define-module (guix build-system glib-or-gtk) ;; exists and does not include a file named "gschemas.compiled", then ;; "glib-compile-schemas" is run in that directory. ;; +;; 'glib-or-gtk-icon-cache' phase: +;; +;; Looks for the existence of icon themes and, if no cache exists, generate +;; the "icon-theme.cache" file. +;; ;; Code: (define %default-modules @@ -76,15 +80,22 @@ (define (default-glib) (let ((module (resolve-interface '(gnu packages glib)))) (module-ref module 'glib))) +(define (default-gtk+) + "Return the default gtk+ package from which we use +\"gtk-update-icon-cache\"." + (let ((module (resolve-interface '(gnu packages gtk)))) + (module-ref module 'gtk+))) + (define* (lower name #:key source inputs native-inputs outputs system target - (glib (default-glib)) (implicit-inputs? #t) + (glib (default-glib)) (gtk+ (default-gtk+)) + (implicit-inputs? #t) (strip-binaries? #t) #:allow-other-keys #:rest arguments) "Return a bag for NAME." (define private-keywords - '(#:source #:target #:glib #:inputs #:native-inputs + '(#:source #:target #:glib #:gtk+ #:inputs #:native-inputs #:outputs #:implicit-inputs?)) (and (not target) ;XXX: no cross-compilation @@ -95,7 +106,8 @@ (define private-keywords `(("source" ,source)) '()) ,@inputs)) - (build-inputs `(("glib:bin" ,glib) + (build-inputs `(("glib:bin" ,glib "bin") ; to compile schemas + ("gtk+" ,gtk+) ; to generate icon cache ,@(if implicit-inputs? (standard-packages) '()) diff --git a/guix/build/glib-or-gtk-build-system.scm b/guix/build/glib-or-gtk-build-system.scm index 9351a70a0e..2fe7aa4474 100644 --- a/guix/build/glib-or-gtk-build-system.scm +++ b/guix/build/glib-or-gtk-build-system.scm @@ -22,6 +22,7 @@ (define-module (guix build glib-or-gtk-build-system) #:use-module (guix build utils) #:use-module (ice-9 match) #:use-module (ice-9 regex) + #:use-module (ice-9 ftw) #:use-module (srfi srfi-1) #:use-module (srfi srfi-26) #:export (%standard-phases @@ -41,6 +42,9 @@ (define (directory-included? directory directories-list) (fold (lambda (s p) (or (string-ci=? s directory) p)) #f directories-list)) +;; We do not include $HOME/.guix-profile/gtk-v.0 (v=2 or 3) because we do not +;; want to mix gtk+-2 and gtk+-3 modules. See +;; https://developer.gnome.org/gtk3/stable/gtk-running.html (define (gtk-module-directories inputs) "Check for the existence of \"libdir/gtk-v.0\" in INPUTS. Return a list with all found directories." @@ -64,20 +68,60 @@ (define (gtk-module-directories inputs) prev))))) (fold gtk-module '() inputs))) -(define (schemas-directories inputs) - "Check for the existence of \"datadir/glib-2.0/schemas\" in INPUTS. Return -a list with all found directories." - (define (glib-schemas input previous) +;; See +;; http://www.freedesktop.org/wiki/DesktopThemeSpec +;; http://freedesktop.org/wiki/Specifications/sound-theme-spec +;; http://freedesktop.org/wiki/Specifications/icon-theme-spec +;; +;; Currently desktop themes are not well supported and do not honor +;; XDG_DATA_DIRS. One example is evince which only looks for desktop themes +;; in $HOME/.themes (for backward compatibility) and in XDG_DATA_HOME (which +;; defaults to $HOME/.local/share). One way to handle these applications +;; appears to be by making $HOME/.themes a symlink to +;; $HOME/.guix-profile/share/themes. +(define (data-directories inputs) + "Check for the existence of \"$datadir/glib-2.0/schemas\" or XDG themes data +in INPUTS. Return a list with all found directories." + (define (data-directory input previous) (let* ((in (match input ((_ . dir) dir) (_ ""))) (datadir (string-append in "/share"))) - (if (and (subdirectory-exists? datadir "/glib-2.0/schemas") + (if (and (or (subdirectory-exists? datadir "/glib-2.0/schemas") + (subdirectory-exists? datadir "/sounds") + (subdirectory-exists? datadir "/themes") + (subdirectory-exists? datadir "/cursors") + (subdirectory-exists? datadir "/wallpapers") + (subdirectory-exists? datadir "/icons")) (not (directory-included? datadir previous))) (cons datadir previous) previous))) - (fold glib-schemas '() inputs)) + (fold data-directory '() inputs)) + +;; All GIO modules are expected to be installed in GLib's $libdir/gio/modules +;; directory. That directory has to include a file called giomodule.cache +;; listing all available modules. GIO can be made aware of modules in other +;; directories with the help of the environment variable GIO_EXTRA_MODULES. +;; The official GIO documentation states that this environment variable should +;; only be used for testing and not in a production environment. However, it +;; appears that there is no other way of specifying multiple modules +;; directories (NIXOS also does use this variable). See +;; https://developer.gnome.org/gio/stable/running-gio-apps.html +(define (gio-module-directories inputs) + "Check for the existence of \"$libdir/gio/modules\" in the INPUTS and +returns a list with all found directories." + (define (gio-module-directory input previous) + (let* ((in (match input + ((_ . dir) dir) + (_ ""))) + (gio-mod-dir (string-append in "/lib/gio/modules"))) + (if (and (directory-exists? gio-mod-dir) + (not (directory-included? gio-mod-dir previous))) + (cons gio-mod-dir previous) + previous))) + + (fold gio-module-directory '() inputs)) (define* (wrap-all-programs #:key inputs outputs (glib-or-gtk-wrap-excluded-outputs '()) @@ -96,27 +140,57 @@ (define handle-output (unless (member output glib-or-gtk-wrap-excluded-outputs) (let* ((bindir (string-append directory "/bin")) (bin-list (find-files bindir ".*")) - (schemas (schemas-directories + (datadirs (data-directories (alist-cons output directory inputs))) (gtk-mod-dirs (gtk-module-directories (alist-cons output directory inputs))) - (schemas-env-var - (if (not (null? schemas)) - `("XDG_DATA_DIRS" ":" prefix ,schemas) + (gio-mod-dirs (gio-module-directories + (alist-cons output directory inputs))) + (data-env-var + (if (not (null? datadirs)) + `("XDG_DATA_DIRS" ":" prefix ,datadirs) #f)) (gtk-mod-env-var (if (not (null? gtk-mod-dirs)) `("GTK_PATH" ":" prefix ,gtk-mod-dirs) + #f)) + (gio-mod-env-var + (if (not (null? gio-mod-dirs)) + `("GIO_EXTRA_MODULES" ":" prefix ,gio-mod-dirs) #f))) (cond - ((and schemas-env-var gtk-mod-env-var) - (for-each (cut wrap-program <> schemas-env-var gtk-mod-env-var) + ((and data-env-var gtk-mod-env-var gio-mod-env-var) + (for-each (cut wrap-program <> + data-env-var + gtk-mod-env-var + gio-mod-env-var) bin-list)) - (schemas-env-var - (for-each (cut wrap-program <> schemas-env-var) + ((and data-env-var gtk-mod-env-var (not gio-mod-env-var)) + (for-each (cut wrap-program <> + data-env-var + gtk-mod-env-var) bin-list)) - (gtk-mod-env-var - (for-each (cut wrap-program <> gtk-mod-env-var) + ((and data-env-var (not gtk-mod-env-var) gio-mod-env-var) + (for-each (cut wrap-program <> + data-env-var + gio-mod-env-var) + bin-list)) + ((and (not data-env-var) gtk-mod-env-var gio-mod-env-var) + (for-each (cut wrap-program <> + gio-mod-env-var + gtk-mod-env-var) + bin-list)) + ((and data-env-var (not gtk-mod-env-var) (not gio-mod-env-var)) + (for-each (cut wrap-program <> + data-env-var) + bin-list)) + ((and (not data-env-var) gtk-mod-env-var (not gio-mod-env-var)) + (for-each (cut wrap-program <> + gtk-mod-env-var) + bin-list)) + ((and (not data-env-var) (not gtk-mod-env-var) gio-mod-env-var) + (for-each (cut wrap-program <> + gio-mod-env-var) bin-list)))))))) (for-each handle-output outputs) @@ -136,12 +210,40 @@ (define* (compile-glib-schemas #:key outputs #:allow-other-keys) #t)))) outputs)) +(define* (generate-icon-cache #:key outputs #:allow-other-keys) + "Implement phase \"glib-or-gtk-icon-cache\": generate icon cache if +needed." + (every (match-lambda + ((output . directory) + (let ((iconsdir (string-append directory + "/share/icons"))) + (with-directory-excursion iconsdir + (for-each + (lambda (dir) + (unless (file-exists? + (string-append iconsdir "/" dir "/" + "icon-theme.cache")) + (system* "gtk-update-icon-cache" + "--ignore-theme-index" + (string-append iconsdir "/" dir)))) + (scandir "." + (lambda (name) + (and + (not (equal? name ".")) + (not (equal? name "..")) + (equal? 'directory + (stat:type (stat name)))))))) + #t))) + outputs)) + (define %standard-phases (alist-cons-after 'install 'glib-or-gtk-wrap wrap-all-programs (alist-cons-after - 'install 'glib-or-gtk-compile-schemas compile-glib-schemas - gnu:%standard-phases))) + 'install 'glib-or-gtk-icon-cache generate-icon-cache + (alist-cons-after + 'install 'glib-or-gtk-compile-schemas compile-glib-schemas + gnu:%standard-phases)))) (define* (glib-or-gtk-build #:key inputs (phases %standard-phases) #:allow-other-keys #:rest args) -- cgit v1.2.3 From b47e1b20bd83191919fd452a6fc8b9a94690c3b7 Mon Sep 17 00:00:00 2001 From: Federico Beffa Date: Thu, 18 Dec 2014 21:23:52 +0100 Subject: gnu: dconf: Add dconf. * gnu/packages/gnome.scm (dconf): New variable. --- gnu/packages/gnome.scm | 53 ++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 53 insertions(+) diff --git a/gnu/packages/gnome.scm b/gnu/packages/gnome.scm index a2ef712220..ee143f3627 100644 --- a/gnu/packages/gnome.scm +++ b/gnu/packages/gnome.scm @@ -1392,3 +1392,56 @@ (define-public vte/gtk+-2 (propagated-inputs `(("gtk+" ,gtk+-2) ; required by libvte.pc ("ncurses" ,ncurses))))) ; required by libvte.la + +(define-public dconf + (package + (name "dconf") + (version "0.22.0") + (source (origin + (method url-fetch) + (uri (string-append + "mirror://gnome/sources/" name "/" + (version-major+minor version) "/" + name "-" version ".tar.xz")) + (sha256 + (base32 "13jb49504bir814v8n8vjip5sazwfwsrnniw87cpg7phqfq7q9qa")))) + (build-system glib-or-gtk-build-system) + (inputs + `(("gtk+" ,gtk+) + ("glib" ,glib) + ("dbus" ,dbus) + ("libxml2" ,libxml2))) + (native-inputs + `(("libxslt" ,libxslt) + ("docbook-xml" ,docbook-xml-4.2) + ("docbook-xsl" ,docbook-xsl) + ("intltool" ,intltool) + ("pkg-config" ,pkg-config))) + (arguments + `(#:tests? #f ; To contact dbus it needs to load /var/lib/dbus/machine-id + ; or /etc/machine-id. + #:configure-flags + ;; Set the correct RUNPATH in binaries. + (list (string-append "LDFLAGS=-Wl,-rpath=" + (assoc-ref %outputs "out") "/lib") + "--disable-gtk-doc-html") ; FIXME: requires gtk-doc + #:phases + (alist-cons-before + 'configure 'fix-docbook + (lambda* (#:key inputs #:allow-other-keys) + (substitute* "docs/Makefile.in" + (("http://docbook.sourceforge.net/release/xsl/current/manpages/docbook.xsl") + (string-append (assoc-ref inputs "docbook-xsl") + "/xml/xsl/docbook-xsl-" + ,(package-version docbook-xsl) + "/manpages/docbook.xsl"))) + (setenv "XML_CATALOG_FILES" + (string-append (assoc-ref inputs "docbook-xml") + "/xml/dtd/docbook/catalog.xml"))) + %standard-phases))) + (home-page "https://developer.gnome.org/dconf") + (synopsis "Low-level GNOME configuration system") + (description "Dconf is a low-level configuration system. Its main purpose +is to provide a backend to GSettings on platforms that don't already have +configuration storage systems.") + (license license:lgpl2.1))) -- cgit v1.2.3 From beb8dc0007f447a0d20e1691b41594fb9d810b83 Mon Sep 17 00:00:00 2001 From: Federico Beffa Date: Thu, 18 Dec 2014 21:32:34 +0100 Subject: gnu: libcanberra: Add default sounds support. * gnu/packages/libcanberra.scm (libcanberra): Add input 'sound-theme-freedesktop'. Add "libcanberra-sound-theme-freedesktop.patch" and related phase 'patch-default-sounds-directory to patch the default sounds directory. --- gnu/packages/libcanberra.scm | 31 ++++++++++++++++++++-- .../libcanberra-sound-theme-freedesktop.patch | 22 +++++++++++++++ 2 files changed, 51 insertions(+), 2 deletions(-) create mode 100644 gnu/packages/patches/libcanberra-sound-theme-freedesktop.patch diff --git a/gnu/packages/libcanberra.scm b/gnu/packages/libcanberra.scm index 764c3272a2..3d43c4f98e 100644 --- a/gnu/packages/libcanberra.scm +++ b/gnu/packages/libcanberra.scm @@ -19,6 +19,7 @@ (define-module (gnu packages libcanberra) #:use-module ((guix licenses) #:select (lgpl2.1+)) + #:use-module (gnu packages) #:use-module (guix packages) #:use-module (guix download) #:use-module (guix build-system gnu) @@ -46,7 +47,21 @@ (define-public libcanberra version ".tar.xz")) (sha256 (base32 - "0wps39h8rx2b00vyvkia5j40fkak3dpipp1kzilqla0cgvk73dn2")))) + "0wps39h8rx2b00vyvkia5j40fkak3dpipp1kzilqla0cgvk73dn2")) + ;; "sound-theme-freedesktop" is the default and fall-back sound theme for + ;; XDG desktops and should always be present. + ;; http://www.freedesktop.org/wiki/Specifications/sound-theme-spec/ + ;; We make sure libcanberra will find it. + ;; + ;; We add the default sounds store directory to the code dealing with + ;; XDG_DATA_DIRS and not XDG_DATA_HOME. This is because XDG_DATA_HOME + ;; can only be a single directory and is inspected first. XDG_DATA_DIRS + ;; can list an arbitrary number of directories and is only inspected + ;; later. This is designed to allows the user to modify any theme at + ;; his pleasure. + (patch-flags '("-p0")) + (patches + (list (search-patch "libcanberra-sound-theme-freedesktop.patch"))))) (build-system gnu-build-system) (inputs `(("alsa-lib" ,alsa-lib) @@ -55,9 +70,21 @@ (define-public libcanberra ("libtool" ,libtool) ("libvorbis" ,libvorbis) ("pulseaudio" ,pulseaudio) - ("udev" ,eudev))) + ("udev" ,eudev) + ("sound-theme-freedesktop" ,sound-theme-freedesktop))) (native-inputs `(("pkg-config" ,pkg-config))) + (arguments + `(#:phases + (alist-cons-before + 'build 'patch-default-sounds-directory + (lambda* (#:key inputs #:allow-other-keys) + (substitute* "src/sound-theme-spec.c" + (("@SOUND_THEME_DIRECTORY@") + (string-append + (assoc-ref inputs "sound-theme-freedesktop") + "/share")))) + %standard-phases))) (home-page "http://0pointer.de/lennart/projects/libcanberra/") (synopsis "Implementation of the XDG Sound Theme and Name Specifications") diff --git a/gnu/packages/patches/libcanberra-sound-theme-freedesktop.patch b/gnu/packages/patches/libcanberra-sound-theme-freedesktop.patch new file mode 100644 index 0000000000..ff998cbf76 --- /dev/null +++ b/gnu/packages/patches/libcanberra-sound-theme-freedesktop.patch @@ -0,0 +1,22 @@ +# We insert a hook called "@SOUND_THEME_DIRECTORY@" where, at build time, we +# insert the directory of the package "sound-theme-freedesktop" in the store. + +--- src/sound-theme-spec.c.orig 2015-01-11 13:13:29.520527358 +0100 ++++ src/sound-theme-spec.c 2015-01-11 14:27:23.035046849 +0100 +@@ -321,9 +321,13 @@ + const char *g; + + if (!(g = getenv("XDG_DATA_DIRS")) || *g == 0) +- return "/usr/local/share:/usr/share"; +- +- return g; ++ return "@SOUND_THEME_DIRECTORY@"; ++ else { ++ const char *stp = ":@SOUND_THEME_DIRECTORY@"; ++ size_t len = strlen(stp) + strlen(g) + 1; ++ char *g2 = (char*) malloc(len); ++ return strcat(strcpy(g2, g), stp); ++ } + } + + static int load_theme_dir(ca_theme_data *t, const char *name) { -- cgit v1.2.3 From 3d243e9c45b83bf7a4bab0514dc6830c29bb2ea5 Mon Sep 17 00:00:00 2001 From: Federico Beffa Date: Thu, 18 Dec 2014 21:48:43 +0100 Subject: gnu: evince: Add inputs. * gnu/packages/gnome.scm (evince): Add 'dconf' and 'libcanberra' inputs. Remove custom phase 'set-mime-search-path which is now handled by glib-or-gtk-build-system. --- gnu/packages/gnome.scm | 18 ++++-------------- 1 file changed, 4 insertions(+), 14 deletions(-) diff --git a/gnu/packages/gnome.scm b/gnu/packages/gnome.scm index ee143f3627..4fea27a865 100644 --- a/gnu/packages/gnome.scm +++ b/gnu/packages/gnome.scm @@ -220,19 +220,7 @@ (define-public evince ;; FIXME: Tests fail with: ;; ImportError: No module named gi.repository ;; Where should that module come from? - #:tests? #f - - #:phases (alist-cons-after - 'install 'set-mime-search-path - (lambda* (#:key inputs outputs #:allow-other-keys) - ;; Wrap 'evince' so that it knows where MIME info is. - (let ((out (assoc-ref outputs "out")) - (mime (assoc-ref inputs "shared-mime-info"))) - (wrap-program (string-append out "/bin/evince") - `("XDG_DATA_DIRS" ":" prefix - ,(list (string-append mime "/share") - (string-append out "/share")))))) - %standard-phases))) + #:tests? #f)) (inputs `(("libspectre" ,libspectre) ;; ("djvulibre" ,djvulibre) @@ -251,7 +239,9 @@ (define-public evince ("libsm" ,libsm) ("libice" ,libice) ("shared-mime-info" ,shared-mime-info) - + ("dconf" ,dconf) + ("libcanberra" ,libcanberra) + ;; For tests. ("dogtail" ,python2-dogtail))) (native-inputs -- cgit v1.2.3 From bb54c8ff051c767e30354e8a6eef5d256a2b2a94 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Mon, 12 Jan 2015 21:12:28 +0100 Subject: gnu: xlockmore: Update to 5.45. * gnu/packages/xlockmore.scm (xlockmore): Update to 5.45. [arguments]: Add #:configure-flags. --- gnu/packages/xlockmore.scm | 12 ++++++++---- 1 file changed, 8 insertions(+), 4 deletions(-) diff --git a/gnu/packages/xlockmore.scm b/gnu/packages/xlockmore.scm index 1665849016..75dad1a78c 100644 --- a/gnu/packages/xlockmore.scm +++ b/gnu/packages/xlockmore.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2013 Ludovic Courtès +;;; Copyright © 2013, 2015 Ludovic Courtès ;;; ;;; This file is part of GNU Guix. ;;; @@ -27,16 +27,20 @@ (define-module (gnu packages xlockmore) (define-public xlockmore (package (name "xlockmore") - (version "5.42") + (version "5.45") (source (origin (method url-fetch) (uri (string-append "http://www.tux.org/~bagleyd/xlock/xlockmore-" version "/xlockmore-" version ".tar.bz2")) (sha256 (base32 - "17xicps92ah9377zk65k9l1bmvzzj3bpxzzwxx21g9696l71gr0z")))) + "1xqm61bbfn5q056w57vp16gvai8nqpcw570ysxlm5h46nh6ai0bz")))) (build-system gnu-build-system) - (arguments '(#:tests? #f)) ; no such thing as a test suite + (arguments + '(#:configure-flags (list (string-append "--enable-appdefaultdir=" + (assoc-ref %outputs "out") + "/lib/X11/app-defaults")) + #:tests? #f)) ;no such thing as a test suite (inputs `(("libX11" ,libx11) ("libXext" ,libxext) -- cgit v1.2.3 From ab69d9ac864250153c1e9f4ef91622a5c3b7a9c3 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Mon, 12 Jan 2015 21:15:15 +0100 Subject: gnu: Move xlockmore to (gnu packages xdisorg). * gnu/packages/xlockmore.scm: Remove. * gnu/packages/xdisorg.scm (xlockmore): New variable, from xlockmore.scm. * gnu-system.am (GNU_SYSTEM_MODULES): Remove xlockmore.scm. --- gnu-system.am | 1 - gnu/packages/xdisorg.scm | 33 +++++++++++++++++++++++++++ gnu/packages/xlockmore.scm | 56 ---------------------------------------------- 3 files changed, 33 insertions(+), 57 deletions(-) delete mode 100644 gnu/packages/xlockmore.scm diff --git a/gnu-system.am b/gnu-system.am index c29b13990b..c520418edc 100644 --- a/gnu-system.am +++ b/gnu-system.am @@ -277,7 +277,6 @@ GNU_SYSTEM_MODULES = \ gnu/packages/wv.scm \ gnu/packages/xfig.scm \ gnu/packages/xiph.scm \ - gnu/packages/xlockmore.scm \ gnu/packages/xml.scm \ gnu/packages/xnee.scm \ gnu/packages/xdisorg.scm \ diff --git a/gnu/packages/xdisorg.scm b/gnu/packages/xdisorg.scm index 2052f7b9be..b48563227c 100644 --- a/gnu/packages/xdisorg.scm +++ b/gnu/packages/xdisorg.scm @@ -3,6 +3,7 @@ ;;; Copyright © 2014 Mark H Weaver ;;; Copyright © 2014 Eric Bavier ;;; Copyright © 2014 Alex Kost +;;; Copyright © 2013, 2015 Ludovic Courtès ;;; ;;; This file is part of GNU Guix. ;;; @@ -30,6 +31,7 @@ (define-module (gnu packages xdisorg) #:use-module (gnu packages pkg-config) #:use-module (gnu packages glib) #:use-module (gnu packages perl) + #:use-module (gnu packages linux) #:use-module (gnu packages xorg)) ;; packages outside the x.org system proper @@ -359,3 +361,34 @@ (define-public unclutter xedit, for example. The human factors crowd would agree it should make things less distracting.") (license license:public-domain))) + +(define-public xlockmore + (package + (name "xlockmore") + (version "5.45") + (source (origin + (method url-fetch) + (uri (string-append "http://www.tux.org/~bagleyd/xlock/xlockmore-" + version "/xlockmore-" version ".tar.bz2")) + (sha256 + (base32 + "1xqm61bbfn5q056w57vp16gvai8nqpcw570ysxlm5h46nh6ai0bz")))) + (build-system gnu-build-system) + (arguments + '(#:configure-flags (list (string-append "--enable-appdefaultdir=" + (assoc-ref %outputs "out") + "/lib/X11/app-defaults")) + #:tests? #f)) ;no such thing as a test suite + (inputs + `(("libX11" ,libx11) + ("libXext" ,libxext) + ("libXt" ,libxt) + ("linux-pam" ,linux-pam))) + (home-page "http://www.tux.org/~bagleyd/xlockmore.html") + (synopsis "Screen locker for the X Window System") + (description + "XLockMore is a classic screen locker and screen saver for the +X Window System.") + (license (license:bsd-style #f "See xlock.c.") + ;; + GPLv2 in modes/glx/biof.c. + ))) diff --git a/gnu/packages/xlockmore.scm b/gnu/packages/xlockmore.scm deleted file mode 100644 index 75dad1a78c..0000000000 --- a/gnu/packages/xlockmore.scm +++ /dev/null @@ -1,56 +0,0 @@ -;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2013, 2015 Ludovic Courtès -;;; -;;; This file is part of GNU Guix. -;;; -;;; GNU Guix is free software; you can redistribute it and/or modify it -;;; under the terms of the GNU General Public License as published by -;;; the Free Software Foundation; either version 3 of the License, or (at -;;; your option) any later version. -;;; -;;; GNU Guix is distributed in the hope that it will be useful, but -;;; WITHOUT ANY WARRANTY; without even the implied warranty of -;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;;; GNU General Public License for more details. -;;; -;;; You should have received a copy of the GNU General Public License -;;; along with GNU Guix. If not, see . - -(define-module (gnu packages xlockmore) - #:use-module (guix packages) - #:use-module (guix download) - #:use-module (guix build-system gnu) - #:use-module (guix licenses) - #:use-module (gnu packages xorg) - #:use-module (gnu packages linux)) - -(define-public xlockmore - (package - (name "xlockmore") - (version "5.45") - (source (origin - (method url-fetch) - (uri (string-append "http://www.tux.org/~bagleyd/xlock/xlockmore-" - version "/xlockmore-" version ".tar.bz2")) - (sha256 - (base32 - "1xqm61bbfn5q056w57vp16gvai8nqpcw570ysxlm5h46nh6ai0bz")))) - (build-system gnu-build-system) - (arguments - '(#:configure-flags (list (string-append "--enable-appdefaultdir=" - (assoc-ref %outputs "out") - "/lib/X11/app-defaults")) - #:tests? #f)) ;no such thing as a test suite - (inputs - `(("libX11" ,libx11) - ("libXext" ,libxext) - ("libXt" ,libxt) - ("linux-pam" ,linux-pam))) - (home-page "http://www.tux.org/~bagleyd/xlockmore.html") - (synopsis "Screen locker for the X Window System") - (description - "XLockMore is a classic screen locker and screen saver for the -X Window System.") - (license (bsd-style #f "See xlock.c.") - ;; + GPLv2 in modes/glx/biof.c. - ))) -- cgit v1.2.3 From 4a4dd5d89dc498c714d0665909597cecdb202027 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Mon, 12 Jan 2015 22:41:05 +0100 Subject: services: user-processes: Write debugging messages to the output port. * gnu/services/base.scm (user-processes-service): Write "sending all processes..." message to the current output port, not to /dev/console. --- gnu/services/base.scm | 10 ++-------- 1 file changed, 2 insertions(+), 8 deletions(-) diff --git a/gnu/services/base.scm b/gnu/services/base.scm index 95edba6e7c..402f5991a5 100644 --- a/gnu/services/base.scm +++ b/gnu/services/base.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2013, 2014 Ludovic Courtès +;;; Copyright © 2013, 2014, 2015 Ludovic Courtès ;;; ;;; This file is part of GNU Guix. ;;; @@ -232,13 +232,7 @@ (define omitted-pids (define lset= (@ (srfi srfi-1) lset=)) - ;; When this happens, all the processes have been - ;; killed, including 'deco', so DMD-OUTPUT-PORT and - ;; thus CURRENT-OUTPUT-PORT are dangling. - (call-with-output-file "/dev/console" - (lambda (port) - (display "sending all processes the TERM signal\n" - port))) + (display "sending all processes the TERM signal\n") (if (null? omitted-pids) (begin -- cgit v1.2.3 From 462a3fa36cddeb683df765b2982f76712f6c40f0 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Mon, 12 Jan 2015 23:26:52 +0100 Subject: monads: Rewrite 'text-file*' using gexps. * guix/monads.scm (text-file*): Move to... * guix/gexp.scm (text-file*): ... here. Rewrite using gexps. * tests/monads.scm ("text-file*"): Move to... * tests/gexp.scm ("text-file*"): ... here. --- guix/gexp.scm | 17 +++++++++++++++-- guix/monads.scm | 53 +---------------------------------------------------- tests/gexp.scm | 26 +++++++++++++++++++++++++- tests/monads.scm | 26 +------------------------- 4 files changed, 42 insertions(+), 80 deletions(-) diff --git a/guix/gexp.scm b/guix/gexp.scm index 78e11f5850..d13e1c46da 100644 --- a/guix/gexp.scm +++ b/guix/gexp.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2014 Ludovic Courtès +;;; Copyright © 2014, 2015 Ludovic Courtès ;;; ;;; This file is part of GNU Guix. ;;; @@ -33,7 +33,8 @@ (define-module (guix gexp) gexp? gexp->derivation gexp->file - gexp->script)) + gexp->script + text-file*)) ;;; Commentary: ;;; @@ -522,6 +523,18 @@ (define (gexp->file name exp) (write '(ungexp exp) port)))) #:local-build? #t)) +(define* (text-file* name #:rest text) + "Return as a monadic value a derivation that builds a text file containing +all of TEXT. TEXT may list, in addition to strings, packages, derivations, +and store file names; the resulting store file holds references to all these." + (define builder + (gexp (call-with-output-file (ungexp output "out") + (lambda (port) + (display (string-append (ungexp-splicing text)) port))))) + + (gexp->derivation name builder)) + + ;;; ;;; Syntactic sugar. diff --git a/guix/monads.scm b/guix/monads.scm index 65683e65de..63c9cd8cfd 100644 --- a/guix/monads.scm +++ b/guix/monads.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2013, 2014 Ludovic Courtès +;;; Copyright © 2013, 2014, 2015 Ludovic Courtès ;;; ;;; This file is part of GNU Guix. ;;; @@ -57,7 +57,6 @@ (define-module (guix monads) store-lift run-with-store text-file - text-file* interned-file package-file origin->derivation @@ -357,56 +356,6 @@ (define* (text-file name text) (lambda (store) (add-text-to-store store name text '()))) -(define* (text-file* name #:rest text) - "Return as a monadic value a derivation that builds a text file containing -all of TEXT. TEXT may list, in addition to strings, packages, derivations, -and store file names; the resulting store file holds references to all these." - (define inputs - ;; Transform packages and derivations from TEXT into a valid input list. - (filter-map (match-lambda - ((? package? p) `("x" ,p)) - ((? derivation? d) `("x" ,d)) - ((x ...) `("x" ,@x)) - ((? string? s) - (and (direct-store-path? s) `("x" ,s))) - (x x)) - text)) - - (define (computed-text text inputs) - ;; Using the lowered INPUTS, return TEXT with derivations replaced with - ;; their output file name. - (define (real-string? s) - (and (string? s) (not (direct-store-path? s)))) - - (let loop ((inputs inputs) - (text text) - (result '())) - (match text - (() - (string-concatenate-reverse result)) - (((? real-string? head) rest ...) - (loop inputs rest (cons head result))) - ((_ rest ...) - (match inputs - (((_ (? derivation? drv) sub-drv ...) inputs ...) - (loop inputs rest - (cons (apply derivation->output-path drv - sub-drv) - result))) - (((_ file) inputs ...) - ;; FILE is the result of 'add-text-to-store' or so. - (loop inputs rest (cons file result)))))))) - - (define (builder inputs) - `(call-with-output-file (assoc-ref %outputs "out") - (lambda (port) - (display ,(computed-text text inputs) port)))) - - ;; TODO: Rewrite using 'gexp->derivation'. - (mlet %store-monad ((inputs (lower-inputs inputs))) - (derivation-expression name (builder inputs) - #:inputs inputs))) - (define* (interned-file file #:optional name #:key (recursive? #t)) "Return the name of FILE once interned in the store. Use NAME as its store diff --git a/tests/gexp.scm b/tests/gexp.scm index ea4df48403..d80f14344d 100644 --- a/tests/gexp.scm +++ b/tests/gexp.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2014 Ludovic Courtès +;;; Copyright © 2014, 2015 Ludovic Courtès ;;; ;;; This file is part of GNU Guix. ;;; @@ -421,6 +421,30 @@ (define shebang (return (and (zero? (close-pipe pipe)) (= (expt n 2) (string->number str))))))) +(test-assert "text-file*" + (let ((references (store-lift references))) + (run-with-store %store + (mlet* %store-monad + ((drv (package->derivation %bootstrap-guile)) + (guile -> (derivation->output-path drv)) + (file (text-file "bar" "This is bar.")) + (text (text-file* "foo" + %bootstrap-guile "/bin/guile " + `(,%bootstrap-guile "out") "/bin/guile " + drv "/bin/guile " + file)) + (done (built-derivations (list text))) + (out -> (derivation->output-path text)) + (refs (references out))) + ;; Make sure we get the right references and the right content. + (return (and (lset= string=? refs (list guile file)) + (equal? (call-with-input-file out get-string-all) + (string-append guile "/bin/guile " + guile "/bin/guile " + guile "/bin/guile " + file))))) + #:guile-for-build (package-derivation %store %bootstrap-guile)))) + (test-assert "printer" (string-match "^#$" diff --git a/tests/monads.scm b/tests/monads.scm index 6e3dd00f72..bac9feb97a 100644 --- a/tests/monads.scm +++ b/tests/monads.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2013, 2014 Ludovic Courtès +;;; Copyright © 2013, 2014, 2015 Ludovic Courtès ;;; ;;; This file is part of GNU Guix. ;;; @@ -177,30 +177,6 @@ (define derivation-expression (readlink (string-append out "/guile-rocks")))))) #:guile-for-build (package-derivation %store %bootstrap-guile))) -(test-assert "text-file*" - (let ((references (store-lift references))) - (run-with-store %store - (mlet* %store-monad - ((drv (package->derivation %bootstrap-guile)) - (guile -> (derivation->output-path drv)) - (file (text-file "bar" "This is bar.")) - (text (text-file* "foo" - %bootstrap-guile "/bin/guile " - `(,%bootstrap-guile "out") "/bin/guile " - drv "/bin/guile " - file)) - (done (built-derivations (list text))) - (out -> (derivation->output-path text)) - (refs (references out))) - ;; Make sure we get the right references and the right content. - (return (and (lset= string=? refs (list guile file)) - (equal? (call-with-input-file out get-string-all) - (string-append guile "/bin/guile " - guile "/bin/guile " - guile "/bin/guile " - file))))) - #:guile-for-build (package-derivation %store %bootstrap-guile)))) - (test-assert "mapm" (every (lambda (monad run) (with-monad monad -- cgit v1.2.3 From abebac46017f626f25b5c84bdcc1013c3d17632f Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Mon, 12 Jan 2015 23:32:34 +0100 Subject: monads: Remove 'derivation-expression'. * guix/monads.scm (lower-inputs, derivation-expression): Remove. * tests/monads.scm (derivation-expression, "mlet* + derivation-expression"): Remove. --- guix/monads.scm | 20 -------------------- tests/monads.scm | 21 --------------------- 2 files changed, 41 deletions(-) diff --git a/guix/monads.scm b/guix/monads.scm index 63c9cd8cfd..20fee79602 100644 --- a/guix/monads.scm +++ b/guix/monads.scm @@ -389,26 +389,6 @@ (define compute-derivation (string-append out "/" file) out)))) -(define (lower-inputs inputs) - "Turn any package from INPUTS into a derivation; return the corresponding -input list as a monadic value." - ;; XXX: This procedure is bound to disappear with 'derivation-expression'. - (with-monad %store-monad - (sequence %store-monad - (map (match-lambda - ((name (? package? package) sub-drv ...) - (mlet %store-monad ((drv (package->derivation package))) - (return `(,name ,drv ,@sub-drv)))) - ((name (? string? file)) - (return `(,name ,file))) - (tuple - (return tuple))) - inputs)))) - -(define derivation-expression - ;; XXX: This procedure is superseded by 'gexp->derivation'. - (store-lift build-expression->derivation)) - (define package->derivation (store-lift package-derivation)) diff --git a/tests/monads.scm b/tests/monads.scm index bac9feb97a..9c3cdd20a7 100644 --- a/tests/monads.scm +++ b/tests/monads.scm @@ -156,27 +156,6 @@ (define (g x) (call-with-input-file b get-string-all)))) #:guile-for-build (package-derivation %store %bootstrap-guile))) -(define derivation-expression - (@@ (guix monads) derivation-expression)) - -(test-assert "mlet* + derivation-expression" - (run-with-store %store - (mlet* %store-monad ((guile (package-file %bootstrap-guile "bin/guile")) - (gdrv (package->derivation %bootstrap-guile)) - (exp -> `(let ((out (assoc-ref %outputs "out"))) - (mkdir out) - (symlink ,guile - (string-append out "/guile-rocks")))) - (drv (derivation-expression "rocks" exp - #:inputs - `(("g" ,gdrv)))) - (out -> (derivation->output-path drv)) - (built? (built-derivations (list drv)))) - (return (and built? - (equal? guile - (readlink (string-append out "/guile-rocks")))))) - #:guile-for-build (package-derivation %store %bootstrap-guile))) - (test-assert "mapm" (every (lambda (monad run) (with-monad monad -- cgit v1.2.3 From bdac3d4bf796402edf581a1f796d9ffc5d5c48f6 Mon Sep 17 00:00:00 2001 From: Mark H Weaver Date: Mon, 12 Jan 2015 17:53:09 -0500 Subject: gnu: libnl: Update to 3.2.25. * gnu/packages/linux.scm (libnl): Update to 3.2.25. --- gnu/packages/linux.scm | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/gnu/packages/linux.scm b/gnu/packages/linux.scm index 6e5aaa1634..0d49c54e61 100644 --- a/gnu/packages/linux.scm +++ b/gnu/packages/linux.scm @@ -2,7 +2,7 @@ ;;; Copyright © 2012, 2013, 2014 Ludovic Courtès ;;; Copyright © 2013, 2014 Andreas Enge ;;; Copyright © 2012 Nikita Karetnikov -;;; Copyright © 2014 Mark H Weaver +;;; Copyright © 2014, 2015 Mark H Weaver ;;; ;;; This file is part of GNU Guix. ;;; @@ -905,7 +905,7 @@ (define-public bridge-utils (define-public libnl (package (name "libnl") - (version "3.2.13") + (version "3.2.25") (source (origin (method url-fetch) (uri (string-append @@ -913,7 +913,7 @@ (define-public libnl version ".tar.gz")) (sha256 (base32 - "1ydw42lsd572qwrfgws97n76hyvjdpanwrxm03lysnhfxkna1ssd")))) + "1icfrv8yihcb74as1gcgmp0wfpdq632q2zvbvqqvjms9cy87bswb")))) (build-system gnu-build-system) (native-inputs `(("flex" ,flex) ("bison" ,bison))) (home-page "http://www.infradead.org/~tgr/libnl/") -- cgit v1.2.3 From 65cd77db204b611009368da704e15add51fd9ba7 Mon Sep 17 00:00:00 2001 From: Mark H Weaver Date: Mon, 12 Jan 2015 18:12:16 -0500 Subject: gnu: Add iw. * gnu/packages/linux.scm (iw): New variable. --- gnu/packages/linux.scm | 26 ++++++++++++++++++++++++++ 1 file changed, 26 insertions(+) diff --git a/gnu/packages/linux.scm b/gnu/packages/linux.scm index 0d49c54e61..12b754bae8 100644 --- a/gnu/packages/linux.scm +++ b/gnu/packages/linux.scm @@ -929,6 +929,32 @@ (define-public libnl ;; 'nl-addr-add.c'), so the result is GPLv2-only. (license gpl2))) +(define-public iw + (package + (name "iw") + (version "3.17") + (source (origin + (method url-fetch) + (uri (string-append + "https://www.kernel.org/pub/software/network/iw/iw-" + version ".tar.xz")) + (sha256 + (base32 + "14zsapqhivk0ws5z21y1ys2c2czi05mzk7bl2yb7qxcfrnsjx9j8")))) + (build-system gnu-build-system) + (native-inputs `(("pkg-config" ,pkg-config))) + (inputs `(("libnl" ,libnl))) + (arguments + `(#:make-flags (list (string-append "PREFIX=" (assoc-ref %outputs "out")) + "CC=gcc") + #:phases (alist-delete 'configure %standard-phases))) + (home-page "http://wireless.kernel.org/en/users/Documentation/iw") + (synopsis "Tool for configuring wireless devices") + (description + "iw is a new nl80211 based CLI configuration utility for wireless +devices. It replaces 'iwconfig', which is deprecated.") + (license isc))) + (define-public powertop (package (name "powertop") -- cgit v1.2.3 From f5895dab8a99c758b2591de334e7ac3ba9eb66fb Mon Sep 17 00:00:00 2001 From: Federico Beffa Date: Tue, 13 Jan 2015 09:11:51 +0100 Subject: build/glib-or-gtk-build-system: Fix 'generate-icon-cache'. Reported by Mark H Weaver * guix/build/glib-or-gtk-build-system.scm (generate-icon-cache): Add check for existence of icons directory. --- guix/build/glib-or-gtk-build-system.scm | 33 +++++++++++++++++---------------- 1 file changed, 17 insertions(+), 16 deletions(-) diff --git a/guix/build/glib-or-gtk-build-system.scm b/guix/build/glib-or-gtk-build-system.scm index 2fe7aa4474..a404a84f3f 100644 --- a/guix/build/glib-or-gtk-build-system.scm +++ b/guix/build/glib-or-gtk-build-system.scm @@ -217,22 +217,23 @@ (define* (generate-icon-cache #:key outputs #:allow-other-keys) ((output . directory) (let ((iconsdir (string-append directory "/share/icons"))) - (with-directory-excursion iconsdir - (for-each - (lambda (dir) - (unless (file-exists? - (string-append iconsdir "/" dir "/" - "icon-theme.cache")) - (system* "gtk-update-icon-cache" - "--ignore-theme-index" - (string-append iconsdir "/" dir)))) - (scandir "." - (lambda (name) - (and - (not (equal? name ".")) - (not (equal? name "..")) - (equal? 'directory - (stat:type (stat name)))))))) + (when (file-exists? iconsdir) + (with-directory-excursion iconsdir + (for-each + (lambda (dir) + (unless (file-exists? + (string-append iconsdir "/" dir "/" + "icon-theme.cache")) + (system* "gtk-update-icon-cache" + "--ignore-theme-index" + (string-append iconsdir "/" dir)))) + (scandir "." + (lambda (name) + (and + (not (equal? name ".")) + (not (equal? name "..")) + (equal? 'directory + (stat:type (stat name))))))))) #t))) outputs)) -- cgit v1.2.3 From 35ed9306b980591f108e01c87a811b63df011fbf Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Tue, 13 Jan 2015 11:06:12 +0100 Subject: doc: Change some occurrences of "the GNU system" to "Guixotic". * doc/guix.texi (GNU Distribution): Explain what "Guixotic" is. (System Installation): Replace "the GNU system" by "Guixotic". (System Configuration): Likewise. (Invoking guix system): Likewise. --- doc/guix.texi | 44 ++++++++++++++++++++++++++++---------------- 1 file changed, 28 insertions(+), 16 deletions(-) diff --git a/doc/guix.texi b/doc/guix.texi index 8341a707d0..d92495b5b2 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -124,7 +124,7 @@ Utilities GNU Distribution * System Installation:: Installing the whole operating system. -* System Configuration:: Configuring a GNU system. +* System Configuration:: Configuring the operating system. * Installing Debugging Files:: Feeding the debugger. * Security Updates:: Deploying security fixes quickly. * Package Modules:: Packages from the programmer's viewpoint. @@ -3233,13 +3233,23 @@ build} supports (@pxref{Invoking guix build, common build options}). @node GNU Distribution @chapter GNU Distribution +@cindex Guixotic Guix comes with a distribution of free software@footnote{The term ``free'' here refers to the @url{http://www.gnu.org/philosophy/free-sw.html,freedom provided to -users of that software}.} that forms the basis of the GNU system. This -includes core GNU packages such as GNU libc, GCC, and Binutils, as well -as many GNU and non-GNU applications. The complete list of available -packages can be browsed +users of that software}.} that forms the basis of the GNU system. The +distribution can be installed on its own (@pxref{System Installation}), +but it is also possible to install Guix as a package manager on top of +an installed GNU/Linux system (@pxref{Installation}). To distinguish +between the two, we refer to the standalone distribution as +``Guixotic''@footnote{``How am I going to pronounce that name?'', you +may ask. Well, we would pronounce it like ``geeks-otic'', for +consistency with Guix---which is quite different from the usual +pronunciation of ``quixotic''.}. + +The distribution provides core GNU packages such as GNU libc, GCC, and +Binutils, as well as many GNU and non-GNU applications. The complete +list of available packages can be browsed @url{http://www.gnu.org/software/guix/package-list.html,on-line} or by running @command{guix package} (@pxref{Invoking guix package}): @@ -3247,7 +3257,7 @@ running @command{guix package} (@pxref{Invoking guix package}): guix package --list-available @end example -Our goal is to build a practical 100% free software distribution of +Our goal has been to provide a practical 100% free software distribution of Linux-based and other variants of GNU, with a focus on the promotion and tight integration of GNU components, and an emphasis on programs and tools that help users exert that freedom. @@ -3274,7 +3284,7 @@ For information on porting to other architectures or kernels, @menu * System Installation:: Installing the whole operating system. -* System Configuration:: Configuring a GNU system. +* System Configuration:: Configuring the operating system. * Installing Debugging Files:: Feeding the debugger. * Security Updates:: Deploying security fixes quickly. * Package Modules:: Packages from the programmer's viewpoint. @@ -3289,9 +3299,11 @@ to join! @xref{Contributing}, for information about how you can help. @node System Installation @section System Installation -This section explains how to install the complete GNU operating system -on a machine. The Guix package manager can also be installed on top of -a running GNU/Linux system, @pxref{Installation}. +@cindex Guixotic +This section explains how to install the standalone distribution, +code-named ``Guixotic'', on a machine. The Guix package manager can +also be installed on top of a running GNU/Linux system, +@pxref{Installation}. @ifinfo @c This paragraph is for people reading this from tty2 of the @@ -3304,13 +3316,13 @@ link that follows: @pxref{Help,,, info, Info: An Introduction}. Hit @subsection Limitations -As of version @value{VERSION}, GNU@tie{}Guix and the GNU system -distribution are alpha software. It may contain bugs and lack important +As of version @value{VERSION}, GNU@tie{}Guix and Guixotic are +not production-ready. They may contain bugs and lack important features. Thus, if you are looking for a stable production system that respects your freedom as a computer user, a good solution at this point is to consider @url{http://www.gnu.org/distros/free-distros.html, one of more established GNU/Linux distributions}. We hope you can soon switch -to the GNU system without fear, of course. In the meantime, you can +to Guixotic without fear, of course. In the meantime, you can also keep using your distribution and try out the package manager on top of it (@pxref{Installation}). @@ -3494,7 +3506,7 @@ about the installation image. @section System Configuration @cindex system configuration -The GNU system supports a consistent whole-system configuration +Guixotic supports a consistent whole-system configuration mechanism. By that we mean that all aspects of the global system configuration---such as the available system services, timezone and locale settings, user accounts---are declared in a single place. Such @@ -4635,7 +4647,7 @@ The type of an entry in the GRUB boot menu. @table @asis @item @code{label} -The label to show in the menu---e.g., @code{"GNU System"}. +The label to show in the menu---e.g., @code{"GNU"}. @item @code{linux} The Linux kernel to boot. @@ -4705,7 +4717,7 @@ This action does not actually install anything. @item init Populate the given directory with all the files necessary to run the operating system specified in @var{file}. This is useful for first-time -installations of the GNU system. For instance: +installations of Guixotic. For instance: @example guix system init my-os-config.scm /mnt -- cgit v1.2.3 From 4655005e2441c7001a89293242719fe35b894e40 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Tue, 13 Jan 2015 11:08:23 +0100 Subject: tests: Properly synchronize threads in the 'home-page' lint tests. * tests/lint.scm (%http-server-lock, %http-server-ready): New variables. (http-open): New procedure. (stub-http-server): Use it. (call-with-http-server): Wrap body in 'with-mutex'. Call 'wait-condition-variable' after 'make-thread'. --- tests/lint.scm | 23 ++++++++++++++++++----- 1 file changed, 18 insertions(+), 5 deletions(-) diff --git a/tests/lint.scm b/tests/lint.scm index c6931329d6..27be5598de 100644 --- a/tests/lint.scm +++ b/tests/lint.scm @@ -1,7 +1,7 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2012, 2013 Cyril Roelandt ;;; Copyright © 2014 Eric Bavier -;;; Copyright © 2014 Ludovic Courtès +;;; Copyright © 2014, 2015 Ludovic Courtès ;;; ;;; This file is part of GNU Guix. ;;; @@ -75,9 +75,20 @@ (define (http-write server client response body) (quit #t) ;exit the server thread (values))) +;; Mutex and condition variable to synchronize with the HTTP server. +(define %http-server-lock (make-mutex)) +(define %http-server-ready (make-condition-variable)) + +(define (http-open . args) + "Start listening for HTTP requests and signal %HTTP-SERVER-READY." + (with-mutex %http-server-lock + (let ((result (apply (@@ (web server http) http-open) args))) + (signal-condition-variable %http-server-ready) + result))) + (define-server-impl stub-http-server ;; Stripped-down version of Guile's built-in HTTP server. - (@@ (web server http) http-open) + http-open (@@ (web server http) http-read) http-write (@@ (web server http) http-close)) @@ -97,9 +108,11 @@ (define (handle request body) `(#:socket ,%http-server-socket))) (const #t))) - (let* ((server (make-thread server-body))) - ;; Normally SERVER exits automatically once it has received a request. - (thunk))) + (with-mutex %http-server-lock + (let ((server (make-thread server-body))) + (wait-condition-variable %http-server-ready %http-server-lock) + ;; Normally SERVER exits automatically once it has received a request. + (thunk)))) (define-syntax-rule (with-http-server code body ...) (call-with-http-server code (lambda () body ...))) -- cgit v1.2.3 From 765f0ac8f9f67f775a667a4276faf85ddde6d7ea Mon Sep 17 00:00:00 2001 From: Ricardo Wurmus Date: Wed, 7 Jan 2015 17:49:00 +0100 Subject: gnu: Add QPDF. * gnu/packages/pdf.scm (qpdf): New variable. --- gnu/packages/pdf.scm | 42 ++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 42 insertions(+) diff --git a/gnu/packages/pdf.scm b/gnu/packages/pdf.scm index 0f9098d8cb..02b55aca9b 100644 --- a/gnu/packages/pdf.scm +++ b/gnu/packages/pdf.scm @@ -37,6 +37,8 @@ (define-module (gnu packages pdf) #:use-module (gnu packages gtk) #:use-module (gnu packages lua) #:use-module (gnu packages curl) + #:use-module (gnu packages pcre) + #:use-module (gnu packages perl) #:use-module (srfi srfi-1)) (define-public poppler @@ -238,3 +240,43 @@ (define-public mupdf line tools for batch rendering (pdfdraw), examining the file structure (pdfshow), and rewriting files (pdfclean).") (license license:agpl3+))) + +(define-public qpdf + (package + (name "qpdf") + (version "5.1.2") + (source (origin + (method url-fetch) + (uri (string-append "mirror://sourceforge/qpdf/qpdf-" + version ".tar.gz")) + (sha256 (base32 + "1zbvhrp0zjzbi6q2bnbxbg6399r47pq5gw3kspzph81j19fqvpg9")))) + (build-system gnu-build-system) + (arguments + '(#:phases (alist-cons-before + 'configure 'patch-paths + (lambda _ + (substitute* "make/libtool.mk" + (("SHELL=/bin/bash") + (string-append "SHELL=" (which "bash")))) + (substitute* (append + '("qtest/bin/qtest-driver") + (find-files "." "\\.test")) + (("/usr/bin/env") (which "env")))) + %standard-phases))) + (native-inputs + `(("pkg-config" ,pkg-config))) + (propagated-inputs + `(("pcre" ,pcre))) + (inputs + `(("zlib" ,zlib) + ("perl" ,perl))) + (synopsis "Command-line tools and library for transforming PDF files") + (description + "QPDF is a command-line program that does structural, content-preserving +transformations on PDF files. It could have been called something like +pdf-to-pdf. It includes support for merging and splitting PDFs and to +manipulate the list of pages in a PDF file. It is not a PDF viewer or a +program capable of converting PDF into other formats.") + (license license:clarified-artistic) + (home-page "http://qpdf.sourceforge.net/"))) -- cgit v1.2.3