amaharaneko/guix-mirrors
1
1
Fork 0
mirror of https://codeberg.org/guix/guix.git synced 2025-10-02 02:15:12 +00:00
Code Issues Projects Releases Packages Wiki Activity Actions

profiles: gtk-icon-themes: Produce only 'icon-theme.cache' files.

Browse source 
Previously the profile will produce a new symlink for each icon file, now it
will reuse existed ones if possible.

* guix/profiles.scm (gtk-icon-themes): Only install 'icon-theme.cache' files
into the output.  Adjust produce docstring.

Fixes: https://issues.guix.gnu.org/77487

Change-Id: Ia452565768753b8a60baf4fc075f6fe5ebb4fa39
Signed-off-by: 宋文武 <iyzsong@member.fsf.org>
This commit is contained in:
Rutherther 2025-03-25 15:36:53 +01:00 • committed by 宋文武
parent 547be88105
commit 32575294ee
No known key found for this signature in database
GPG key ID: D415BF253B515976
1 changed files with 16 additions and 10 deletions
Download patch file Download diff file Expand all files Collapse all files

26
guix/profiles.scm
View file

@ -1352,8 +1352,8 @@ creates the Glib 'gschemas.compiled' file."
(return #f)))) (return #f))))
(define* (gtk-icon-themes manifest #:optional system) (define* (gtk-icon-themes manifest #:optional system)
"Return a derivation that unions all icon themes from manifest entries and "Return a derivation that builds the @file{icon-theme.cache} file for each
creates the GTK+ 'icon-theme.cache' file for each theme." icon theme. It's used by GTK applications to speedup icons loading."
(define gtk+ ; lazy reference (define gtk+ ; lazy reference
(module-ref (resolve-interface '(gnu packages gtk)) 'gtk+)) (module-ref (resolve-interface '(gnu packages gtk)) 'gtk+))
@ -1382,23 +1382,29 @@ creates the GTK+ 'icon-theme.cache' file for each theme."
(let* ((destdir (string-append #$output "/share/icons")) (let* ((destdir (string-append #$output "/share/icons"))
(icondirs (filter file-exists? (icondirs (filter file-exists?
(map (cut string-append <> "/share/icons") (map (cut string-append <> "/share/icons")
'#$(manifest-inputs manifest))))) '#$(manifest-inputs manifest))))
(cache-file-name "icon-theme.cache")
(scratchdir (string-append (getcwd) "/icons")))
;; Union all the icons. ;; Union all the icons.
(mkdir-p (string-append #$output "/share")) (union-build scratchdir icondirs
(union-build destdir icondirs
#:log-port (%make-void-port "w")) #:log-port (%make-void-port "w"))
;; Update the 'icon-theme.cache' file for each icon theme. ;; Update the 'icon-theme.cache' file for each icon theme.
(for-each (for-each
(lambda (theme) (lambda (theme)
(let ((dir (string-append destdir "/" theme))) (let* ((dir (string-append scratchdir "/" theme))
;; Occasionally DESTDIR contains plain files, such as (cache-file (string-append dir "/" cache-file-name)))
;; Occasionally SCRATCHDIR contains plain files, such as
;; "abiword_48.png". Ignore these. ;; "abiword_48.png". Ignore these.
(when (file-is-directory? dir) (when (file-is-directory? dir)
(ensure-writable-directory dir) (ensure-writable-directory dir)
(system* #+gtk-update-icon-cache "-t" dir "--quiet")))) (system* #+gtk-update-icon-cache "-t" dir "--quiet")
(scandir destdir (negate (cut member <> '("." ".."))))))))) (when (file-exists? cache-file)
(mkdir-p (string-append destdir "/" theme))
(copy-file
cache-file
(string-append destdir "/" theme "/" cache-file-name))))))
(scandir scratchdir (negate (cut member <> '("." "..")))))))))
;; Don't run the hook when there's nothing to do. ;; Don't run the hook when there's nothing to do.
(if %gtk+ (if %gtk+