13/15: PRELIMINARY: system: grub: Convert grub background using rsvg-convert, not inkscape.

[Mark H. Weaver]

mhw pushed a commit to branch mhw-core-updates
in repository guix.

commit 6124dc0be50143059309c529839e40ad45487189
Author: Mark H Weaver <address@hidden>
Date:   Wed Aug 19 17:26:02 2015 -0400

    PRELIMINARY: system: grub: Convert grub background using rsvg-convert, not 
inkscape.
    
    * gnu/system/grub.scm (svg->png): Accept additional arguments 'width' and
      'height'.  Reimplement using rsvg-convert and emacs instead of inkscape.
      (resize-image): Remove.
      (grub-background-image): Remove 'resize-image' step.  Pass 'width' and
      'height' to 'svg->png'.
---
 gnu/system/grub.scm |   57 ++++++++++++++++++++++++++++++++------------------
 1 files changed, 36 insertions(+), 21 deletions(-)

diff --git a/gnu/system/grub.scm b/gnu/system/grub.scm
index e0717cc..b05d7ac 100644
--- a/gnu/system/grub.scm
+++ b/gnu/system/grub.scm
@@ -1,5 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2013, 2014, 2015 Ludovic Courtès <address@hidden>
+;;; Copyright © 2015 Mark H Weaver <address@hidden>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -26,8 +27,8 @@
   #:use-module (guix download)
   #:use-module (gnu artwork)
   #:autoload   (gnu packages grub) (grub)
-  #:autoload   (gnu packages inkscape) (inkscape)
-  #:autoload   (gnu packages imagemagick) (imagemagick)
+  #:autoload   (gnu packages emacs) (emacs-no-x)
+  #:autoload   (gnu packages gnome) (librsvg)
   #:autoload   (gnu packages compression) (gzip)
   #:use-module (ice-9 match)
   #:use-module (ice-9 regex)
@@ -120,25 +121,40 @@
 ;;; Background image & themes.
 ;;;
 
-(define (svg->png svg)
+(define (svg->png svg width height)
   "Build a PNG from SVG."
   ;; Don't use #:local-build? so that it's substitutable.
-  (gexp->derivation "grub-image.png"
-                    #~(zero?
-                       (system* (string-append #$inkscape "/bin/inkscape")
-                                "--without-gui"
-                                (string-append "--export-png=" #$output)
-                                #$svg))))
-
-(define (resize-image image width height)
-  "Resize IMAGE to WIDTHxHEIGHT."
-  ;; Don't use #:local-build? so that it's substitutable.
-  (let ((size (string-append (number->string width)
-                             "x" (number->string height))))
-    (gexp->derivation "grub-image.resized.png"
-                      #~(zero?
-                         (system* (string-append #$imagemagick "/bin/convert")
-                                  "-resize" #$size #$image #$output)))))
+  (let ((width  (number->string width))
+        (height (number->string height)))
+    (gexp->derivation
+     "grub-image.png"
+     #~(begin
+         (use-modules (guix build emacs-utils))
+         (let ((image-file "/tmp/image.svg"))
+           ;; The SVG images in the guix-artwork repository contain a bottom
+           ;; "Background" layer containing a checkerboard pattern.  Here we
+           ;; remove that layer.
+           (copy-file #$svg image-file)
+           (chmod image-file #o644)
+           (parameterize ((%emacs (string-append #$emacs-no-x "/bin/emacs")))
+             (emacs-batch-edit-file image-file
+               '(progn (goto-char (point-min))
+                       (when (re-search-forward "inkscape:label=\"Background\""
+                                                nil nil)
+                         (nxml-backward-up-element)
+                         (set-mark (point))
+                         (nxml-forward-element)
+                         (kill-region (mark) (point))
+                         (basic-save-buffer)))))
+           (zero?
+            (system* (string-append #$librsvg "/bin/rsvg-convert")
+                     "--width" #$width
+                     "--height" #$height
+                     "--background-color" "black"
+                     "--format" "png"
+                     "--output" #$output
+                     image-file))))
+     #:modules '((guix build emacs-utils)))))
 
 (define* (grub-background-image config #:key (width 640) (height 480))
   "Return the GRUB background image defined in CONFIG with a ratio of
@@ -148,8 +164,7 @@ WIDTH/HEIGHT, or #f if none was found."
                         (= (grub-image-aspect-ratio image) ratio))
                       (grub-theme-images (grub-configuration-theme config)))))
     (if image
-        (mlet %store-monad ((png (svg->png (grub-image-file image))))
-          (resize-image png width height))
+        (svg->png (grub-image-file image) width height)
         (with-monad %store-monad
           (return #f)))))