From c8c25704aeb2e5fa4feb6a86235f9565738eea99 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Tue, 6 Sep 2016 20:19:21 +0200 Subject: profiles: Add manifest-transaction helper procedures. * guix/profiles.scm (manifest-transaction-install-entry) (manifest-transaction-remove-pattern) (manifest-transaction-null?): New procedures. * tests/profiles.scm ("manifest-transaction-null?"): New test. --- guix/profiles.scm | 27 ++++++++++++++++++++++++++- 1 file changed, 26 insertions(+), 1 deletion(-) (limited to 'guix/profiles.scm') diff --git a/guix/profiles.scm b/guix/profiles.scm index cd448e3f25..ac2fa051b2 100644 --- a/guix/profiles.scm +++ b/guix/profiles.scm @@ -78,6 +78,9 @@ manifest-transaction? manifest-transaction-install manifest-transaction-remove + manifest-transaction-install-entry + manifest-transaction-remove-pattern + manifest-transaction-null? manifest-perform-transaction manifest-transaction-effects @@ -383,6 +386,28 @@ no match.." (remove manifest-transaction-remove ; list of (default '()))) +(define (manifest-transaction-install-entry entry transaction) + "Augment TRANSACTION's set of installed packages with ENTRY, a +." + (manifest-transaction + (inherit transaction) + (install + (cons entry (manifest-transaction-install transaction))))) + +(define (manifest-transaction-remove-pattern pattern transaction) + "Add PATTERN to TRANSACTION's list of packages to remove." + (manifest-transaction + (inherit transaction) + (remove + (cons pattern (manifest-transaction-remove transaction))))) + +(define (manifest-transaction-null? transaction) + "Return true if TRANSACTION has no effect---i.e., it neither installs nor +remove software." + (match transaction + (($ () ()) #t) + (($ _ _) #f))) + (define (manifest-transaction-effects manifest transaction) "Compute the effect of applying TRANSACTION to MANIFEST. Return 4 values: the list of packages that would be removed, installed, upgraded, or downgraded @@ -424,7 +449,7 @@ replace it." downgrade))))))) (define (manifest-perform-transaction manifest transaction) - "Perform TRANSACTION on MANIFEST and return new manifest." + "Perform TRANSACTION on MANIFEST and return the new manifest." (let ((install (manifest-transaction-install transaction)) (remove (manifest-transaction-remove transaction))) (manifest-add (manifest-remove manifest remove) -- cgit v1.2.3 From 03763d6473bcd6c7a84bcc3a6aa7bc2d1ee1e44f Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Tue, 6 Sep 2016 23:05:26 +0200 Subject: profiles: Export accessors. * guix/profiles.scm (manifest-pattern-name, manifest-pattern-version) (manifest-pattern-output): Export. --- guix/profiles.scm | 3 +++ 1 file changed, 3 insertions(+) (limited to 'guix/profiles.scm') diff --git a/guix/profiles.scm b/guix/profiles.scm index ac2fa051b2..4a2ba1c2f4 100644 --- a/guix/profiles.scm +++ b/guix/profiles.scm @@ -67,6 +67,9 @@ manifest-pattern manifest-pattern? + manifest-pattern-name + manifest-pattern-version + manifest-pattern-output manifest-remove manifest-add -- cgit v1.2.3 From 2c9f4786c967d2e5090cef2a18bebf8d840e9428 Mon Sep 17 00:00:00 2001 From: Ricardo Wurmus Date: Thu, 22 Sep 2016 22:25:12 +0200 Subject: profiles: manifest-lookup-package: Optionally match version prefix. * guix/profiles.scm (manifest-lookup-package): Optionally filter store item matches by version prefix. --- guix/profiles.scm | 19 ++++++++++++++----- 1 file changed, 14 insertions(+), 5 deletions(-) (limited to 'guix/profiles.scm') diff --git a/guix/profiles.scm b/guix/profiles.scm index 4a2ba1c2f4..78deeb7977 100644 --- a/guix/profiles.scm +++ b/guix/profiles.scm @@ -472,21 +472,30 @@ replace it." (cons (gexp-input thing output) deps))) (manifest-entries manifest))) -(define (manifest-lookup-package manifest name) +(define* (manifest-lookup-package manifest name #:optional version) "Return as a monadic value the first package or store path referenced by -MANIFEST that named NAME, or #f if not found." +MANIFEST that is named NAME and optionally has the given VERSION prefix, or #f +if not found." ;; Return as a monadic value the package or store path referenced by the ;; manifest ENTRY, or #f if not referenced. (define (entry-lookup-package entry) (define (find-among-inputs inputs) (find (lambda (input) (and (package? input) - (equal? name (package-name input)))) + (equal? name (package-name input)) + (if version + (string-prefix? version (package-version input)) + #t))) inputs)) (define (find-among-store-items items) (find (lambda (item) - (equal? name (package-name->name+version - (store-path-package-name item)))) + (let-values (((pkg-name pkg-version) + (package-name->name+version + (store-path-package-name item)))) + (and (equal? name pkg-name) + (if version + (string-prefix? version pkg-version) + #t)))) items)) ;; TODO: Factorize. -- cgit v1.2.3 From 7ddc178093a4e705c9221ef2758eeeb9af7284f8 Mon Sep 17 00:00:00 2001 From: Ricardo Wurmus Date: Thu, 22 Sep 2016 22:27:06 +0200 Subject: profiles: Build GTK+ input module cache. * guix/profiles.scm (gtk-im-modules): New procedure. (%default-profile-hooks): Add it. --- guix/profiles.scm | 62 +++++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 62 insertions(+) (limited to 'guix/profiles.scm') diff --git a/guix/profiles.scm b/guix/profiles.scm index 78deeb7977..e7319a8a10 100644 --- a/guix/profiles.scm +++ b/guix/profiles.scm @@ -4,6 +4,7 @@ ;;; Copyright © 2014, 2016 Alex Kost ;;; Copyright © 2015 Mark H Weaver ;;; Copyright © 2015 Sou Bunnbu +;;; Copyright © 2016 Ricardo Wurmus ;;; ;;; This file is part of GNU Guix. ;;; @@ -723,6 +724,66 @@ creates the GTK+ 'icon-theme.cache' file for each theme." #:substitutable? #f) (return #f)))) +(define (gtk-im-modules manifest) + "Return a derivation that builds the cache files for input method modules +for both major versions of GTK+." + + (mlet %store-monad ((gtk+ (manifest-lookup-package manifest "gtk+" "3")) + (gtk+-2 (manifest-lookup-package manifest "gtk+" "2"))) + + (define (build gtk gtk-version) + (let ((major (string-take gtk-version 1))) + (with-imported-modules '((guix build utils) + (guix build union) + (guix build profiles) + (guix search-paths) + (guix records)) + #~(begin + (use-modules (guix build utils) + (guix build union) + (guix build profiles) + (ice-9 popen) + (srfi srfi-1) + (srfi srfi-26)) + + (let* ((prefix (string-append "/lib/gtk-" #$major ".0/" + #$gtk-version)) + (query (string-append #$gtk "/bin/gtk-query-immodules-" + #$major ".0")) + (destdir (string-append #$output prefix)) + (moddirs (cons (string-append #$gtk prefix "/immodules") + (filter file-exists? + (map (cut string-append <> prefix "/immodules") + '#$(manifest-inputs manifest))))) + (modules (append-map (cut find-files <> "\\.so$") + moddirs))) + + ;; Generate a new immodules cache file. + (mkdir-p (string-append #$output prefix)) + (let ((pipe (apply open-pipe* OPEN_READ query modules)) + (outfile (string-append #$output prefix + "/immodules-gtk" #$major ".cache"))) + (dynamic-wind + (const #t) + (lambda () + (call-with-output-file outfile + (lambda (out) + (while (not (eof-object? (peek-char pipe))) + (write-char (read-char pipe) out)))) + #t) + (lambda () + (close-pipe pipe))))))))) + + ;; Don't run the hook when there's nothing to do. + (let ((gexp #~(begin + #$(if gtk+ (build gtk+ "3.0.0") #t) + #$(if gtk+-2 (build gtk+-2 "2.10.0") #t)))) + (if (or gtk+ gtk+-2) + (gexp->derivation "gtk-im-modules" gexp + #:local-build? #t + #:substitutable? #f) + (return #f))))) + (define (xdg-desktop-database manifest) "Return a derivation that builds the @file{mimeinfo.cache} database from desktop files. It's used to query what applications can handle a given @@ -844,6 +905,7 @@ files for the truetype fonts of the @var{manifest} entries." ghc-package-cache-file ca-certificate-bundle gtk-icon-themes + gtk-im-modules xdg-desktop-database xdg-mime-database)) -- cgit v1.2.3