From mboxrd@z Thu Jan 1 00:00:00 1970 From: =?UTF-8?q?=E5=AE=8B=E6=96=87=E6=AD=A6?= Subject: [PATCH] profiles: Add gtk-icon-themes hook. Date: Wed, 13 May 2015 17:12:12 +0800 Message-ID: <1431508332-8042-1-git-send-email-iyzsong@gmail.com> Mime-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Return-path: Received: from eggs.gnu.org ([2001:4830:134:3::10]:49810) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1YsShW-0006Fz-Ce for guix-devel@gnu.org; Wed, 13 May 2015 05:11:39 -0400 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1YsShT-0003iD-DI for guix-devel@gnu.org; Wed, 13 May 2015 05:11:38 -0400 Received: from mail-pa0-x231.google.com ([2607:f8b0:400e:c03::231]:34484) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1YsShT-0003i0-2p for guix-devel@gnu.org; Wed, 13 May 2015 05:11:35 -0400 Received: by pacyx8 with SMTP id yx8so44548223pac.1 for ; Wed, 13 May 2015 02:11:34 -0700 (PDT) List-Id: "Development of GNU Guix and the GNU System distribution." List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guix-devel-bounces+gcggd-guix-devel=m.gmane.org@gnu.org Sender: guix-devel-bounces+gcggd-guix-devel=m.gmane.org@gnu.org To: guix-devel@gnu.org * guix/profiles.scm (gtk-icon-themes): New function. (%default-profile-hooks): Add it. --- guix/profiles.scm | 79 ++++++++++++++++++++++++++++++++++++++++++++++++++++++- 1 file changed, 78 insertions(+), 1 deletion(-) diff --git a/guix/profiles.scm b/guix/profiles.scm index 11d9bf0..33cdb28 100644 --- a/guix/profiles.scm +++ b/guix/profiles.scm @@ -3,6 +3,7 @@ ;;; Copyright © 2013 Nikita Karetnikov ;;; Copyright © 2014 Alex Kost ;;; Copyright © 2015 Mark H Weaver +;;; Copyright © 2015 Sou Bunnbu ;;; ;;; This file is part of GNU Guix. ;;; @@ -573,12 +574,88 @@ MANIFEST. Single-file bundles are required by programs such as Git and Lynx." #:modules '((guix build utils)) #:local-build? #t)) +(define (gtk-icon-themes manifest) + "Return a derivation that unions all icon themes from manifest entries and +creates the GTK+ 'icon-theme.cache' file for each icon theme." + (define (entry-lookup-gtk+ store entry) + "Return the GTK+ package or store path referenced by the manifest ENTRY, or +#f if not referenced." + ;; Find GTK+ in a list of packages. + (define (by-packages packages) + (find (lambda (package) + (equal? "gtk+" (package-name package))) + packages)) + + ;; Find GTK+ in a list of store paths. + (define (by-paths paths) + (find (lambda (path) + (equal? "gtk+" + (package-name->name+version + (store-path-package-name path)))) + paths)) + + (match (manifest-entry-item entry) + ((? package? package) + (by-packages (delete-duplicates + (map cadr (package-transitive-inputs package))))) + ((? string? path) + (by-paths (references store path))))) + + (define (manifest-lookup-gtk+ store manifest) + "Return the first GTK+ package or store path referenced by MANIFEST entries, +or #f if not referenced by any entry." + (any (cut entry-lookup-gtk+ store <>) (manifest-entries manifest))) + + (define gtk+ + (with-store store + (manifest-lookup-gtk+ store manifest))) + + (define build + #~(begin + (use-modules (guix build utils) + (guix build union) + (srfi srfi-26) + (ice-9 ftw)) + (let* ((destdir (string-append #$output "/share/icons")) + (icons (filter file-exists? + (map (cut string-append <> "/share/icons") + '#$(manifest-inputs manifest)))) + (update-icon-cache (string-append + #+gtk+ "/bin/gtk-update-icon-cache"))) + + ;; XXX: Should move to (guix build utils). + (define ensure-writable-directory + (@@ (guix build profiles) ensure-writable-directory)) + + ;; Union all the icons. + (mkdir-p (string-append #$output "/share")) + (union-build destdir icons) + ;; Update the 'icon-theme.cache' file for each icon theme. + (for-each + (lambda (theme) + (let ((dir (string-append #$output "/share/icons/" theme))) + (ensure-writable-directory dir) + (system* update-icon-cache "-t" dir))) + (scandir destdir (negate (cut member <> '("." "..")))))))) + + ;; Don't run the hook when there's nothing to do. + (if gtk+ + (gexp->derivation "gtk-icon-themes" build + #:modules '((guix build utils) + (guix build union) + (guix build profiles) + (guix search-paths) + (guix records)) + #:local-build? #t) + #f)) + (define %default-profile-hooks ;; This is the list of derivation-returning procedures that are called by ;; default when making a non-empty profile. (list info-dir-file ghc-package-cache-file - ca-certificate-bundle)) + ca-certificate-bundle + gtk-icon-themes)) (define* (profile-derivation manifest #:key -- 2.2.1