[PATCH] Add scratch

[Nicolas Goaziou]

Hello,

The following patch adds Scratch to the Guix packages.

There are some caveats:

- it is not the latest version of scratch (1.4 instead of 2.0) as this
  one required Adobe Air for the offline editor and Flash plugin online.

- it freezes when returning from fullscreen execution of a script. Note
  that the same happens with the Debian package, so there's probably
  little I can do.

- the installation merely copies Scratch.image, which is an image of the
  VM. It is not a binary blob. You can inspect and modify code from
  within the application. See
  <https://wiki.scratch.mit.edu/wiki/Scratch_1.4_Source_Code> for details.

- "/usr/share/scratch" directory is hard-coded. As a consequence Scratch
  cannot find translation files or artwork. You can still import artwork
  from the store directory but it is not a great out-of-the box
  experience.

  I notified the issue to the developers
  (https://github.com/LLK/Scratch_1.4/issues) but, considering other
  issues there are years old, I have little hope about it.

  If there's an idea on how to fake the "/usr/share/scratch" directory,
  I'm all ears.

Feedback welcome.

Regards,

-- 
Nicolas Goaziou                                                0x80A93738

>From 19bd9de8cd1cd596703db5a92e18191d91762150 Mon Sep 17 00:00:00 2001
From: Nicolas Goaziou <address@hidden>
Date: Fri, 26 Aug 2016 12:32:23 +0200
Subject: [PATCH] gnu: education: Add scratch.

* gnu/packages/education.scm (scratch): New variable.

* gnu/packages/patches/scratch-desktopfile-semicolon.patch:
* gnu/packages/patches/scratch-use-squeak-plugins.patch: New files.
* gnu/local.mk (dist_patch_DATA): Add them.
---
 gnu/local.mk                                       |  2 +
 gnu/packages/education.scm                         | 98 +++++++++++++++++++++-
 .../patches/scratch-desktopfile-semicolon.patch    |  8 ++
 .../patches/scratch-use-squeak-plugins.patch       | 18 ++++
 4 files changed, 124 insertions(+), 2 deletions(-)
 create mode 100644 gnu/packages/patches/scratch-desktopfile-semicolon.patch
 create mode 100644 gnu/packages/patches/scratch-use-squeak-plugins.patch

diff --git a/gnu/local.mk b/gnu/local.mk
index efb00b9..9b8c561 100644
--- a/gnu/local.mk
+++ b/gnu/local.mk
@@ -779,6 +779,8 @@ dist_patch_DATA =                                           
\
   %D%/packages/patches/sed-hurd-path-max.patch                 \
   %D%/packages/patches/scheme48-tests.patch                    \
   %D%/packages/patches/scotch-test-threading.patch             \
+  %D%/packages/patches/scratch-desktop-semicolon.patch         \
+  %D%/packages/patches/scratch-use-squeak-plugins.patch                \
   %D%/packages/patches/sdl-libx11-1.6.patch                    \
   %D%/packages/patches/serf-comment-style-fix.patch            \
   %D%/packages/patches/serf-deflate-buckets-test-fix.patch     \
diff --git a/gnu/packages/education.scm b/gnu/packages/education.scm
index 14c1bac..f84ca52 100644
--- a/gnu/packages/education.scm
+++ b/gnu/packages/education.scm
@@ -1,6 +1,7 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2016 Danny Milosavljevic <address@hidden>
 ;;; Copyright © 2016 Ricardo Wurmus <address@hidden>
+;;; Copyright © 2016 Nicolas Goaziou <address@hidden>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -18,7 +19,6 @@
 ;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
 
 (define-module (gnu packages education)
-  #:use-module (ice-9 regex)
   #:use-module (gnu packages)
   #:use-module (gnu packages qt)
   #:use-module (gnu packages compression)
@@ -31,6 +31,7 @@
   #:use-module (gnu packages pkg-config)
   #:use-module (gnu packages python)
   #:use-module (gnu packages sdl)
+  #:use-module (gnu packages smalltalk)
   #:use-module (gnu packages texinfo)
   #:use-module (gnu packages xml)
   #:use-module ((guix licenses) #:prefix license:)
@@ -38,9 +39,10 @@
   #:use-module (guix download)
   #:use-module (guix svn-download)
   #:use-module (guix utils)
+  #:use-module (guix build-system glib-or-gtk)
   #:use-module (guix build-system gnu)
   #:use-module (guix build-system cmake)
-  #:use-module (srfi srfi-1))
+  #:use-module (srfi srfi-26))
 
 (define-public stellarium
   (package
@@ -138,3 +140,95 @@ of categories with some of the activities available in 
that category.
 @end enumerate
 ")
     (license license:gpl3+)))
+
+(define-public scratch
+  (package
+    (name "scratch")
+    (version "1.4.0.7")
+    (source
+     (origin
+       (method url-fetch)
+       (uri (string-append "https://download.scratch.mit.edu/";
+                           "scratch-" version ".src.tar.gz"))
+       (sha256
+        (base32
+         "0gka4acblxd3q0bc58pzjdr6k6fx6qww5vj724nvmwnfiqkqjkdr"))
+       (patches (search-patches
+                 "scratch-desktopfile-semicolon.patch"
+                 "scratch-use-squeak-plugins.patch"))))
+    (inputs
+     `(("cairo" ,cairo)
+       ("pango" ,pango)
+       ("shared-mime-info" ,shared-mime-info)))
+    (native-inputs
+     `(("pkg-config" ,pkg-config)))
+    (propagated-inputs `(("squeak-vm" ,squeak-vm)))
+    (build-system glib-or-gtk-build-system)
+    (arguments
+     `(#:tests? #f                      ;No check target
+       #:modules ((srfi srfi-26)
+                  ,@%glib-or-gtk-build-system-modules)
+       #:phases
+       (modify-phases %standard-phases
+         (delete 'configure)
+         (delete 'build)
+         (add-after 'unpack 'fix-executable
+           (lambda* (#:key outputs inputs #:allow-other-keys)
+             ;; Fix hard-coded paths to VM in the shell script.  Also
+             ;; make it executable.
+             (let* ((scratch "src/scratch")
+                    (out (assoc-ref outputs "out"))
+                    (vm  (assoc-ref inputs "squeak-vm"))
+                    (share (string-append out "/share/scratch")))
+               (chmod scratch #o755)
+               (substitute* scratch
+                 (("^VM=.*$")
+                  (string-append "VM=\"" vm "/bin/squeak\"\n"))
+                 (("^IMAGE=.*$")
+                  (string-append "IMAGE=\"" share "/Scratch.image\"\n")))
+               #t)))
+         (replace 'install
+           (lambda* (#:key outputs inputs #:allow-other-keys)
+             ;; There is no "install" target in the Makefile, so we
+             ;; roll our own.
+             (let* ((out (assoc-ref outputs "out"))
+                    (applications (string-append out "/share/applications"))
+                    (bin (string-append out "/bin"))
+                    (man (string-append out "/share/man/man1"))
+                    (mime (string-append out "/share/mime/packages"))
+                    (share (string-append out "/share/scratch")))
+               (for-each (cut copy-recursively <> share)
+                         '("Help" "locale" "Media" "Projects"))
+               (for-each (cut install-file <> share)
+                         '("Scratch.image" "Scratch.ini"))
+               (install-file "src/scratch" bin)
+               (install-file "src/man/scratch.1.gz" man)
+               (install-file "src/scratch.xml" mime)
+               (install-file "src/scratch.desktop" applications)
+               (let ((hicolor (string-append out "/share/icons/hicolor")))
+                 (with-directory-excursion "src/icons/32x32"
+                   (install-file "scratch.xpm"
+                                 (string-append out "/share/pixmaps")))
+                 (with-directory-excursion "src/icons/48x48"
+                   (install-file "scratch.png"
+                                 (string-append hicolor "/48x48/apps"))
+                   (install-file "gnome-mime-application-x-scratch-project.png"
+                                 (string-append hicolor "/48x48/mimetypes")))
+                 (with-directory-excursion "src/icons/128x128"
+                   (install-file "scratch.png"
+                                 (string-append hicolor "/128x128/apps"))
+                   (install-file "gnome-mime-application-x-scratch-project.png"
+                                 (string-append hicolor 
"/128x128/mimetypes"))))
+               #t))))))
+    (synopsis "Easy to use programming environment for ages 8 and up")
+    (description "Scratch is an easy, interactive, collaborative
+programming environment designed for creation of interactive stories,
+animations, games, music, and art -- and sharing these on the web.
+Scratch is designed to help young people (ages 8 and up) develop 21st
+century learning skills.  As they create Scratch projects, young people
+learn important mathematical and computational ideas, while also
+gaining a deeper understanding of the process of design.")
+    (home-page "http://scratch.mit.edu";)
+    ;; Source is GPL2 licensed, Plugins are MIT licensed and Artwork (sprites,
+    ;; backgrounds, sounds...) is CC-BY-SA3.0 licensed.
+    (license (list license:gpl2 license:x11 license:cc-by-sa3.0))))
diff --git a/gnu/packages/patches/scratch-desktopfile-semicolon.patch 
b/gnu/packages/patches/scratch-desktopfile-semicolon.patch
new file mode 100644
index 0000000..b013193
--- /dev/null
+++ b/gnu/packages/patches/scratch-desktopfile-semicolon.patch
@@ -0,0 +1,8 @@
+--- scratch-1.4.0.6.src/src/scratch.desktop-semicolon  2012-09-10 
13:04:14.075940196 -0400
++++ scratch-1.4.0.6.src/src/scratch.desktop    2012-09-10 13:04:18.345846641 
-0400
+@@ -6,4 +6,4 @@
+ Type=Application
+ Icon=scratch
+ Categories=Development;
+-MimeType=application/x-scratch-project
++MimeType=application/x-scratch-project;
diff --git a/gnu/packages/patches/scratch-use-squeak-plugins.patch 
b/gnu/packages/patches/scratch-use-squeak-plugins.patch
new file mode 100644
index 0000000..96fa801
--- /dev/null
+++ b/gnu/packages/patches/scratch-use-squeak-plugins.patch
@@ -0,0 +1,18 @@
+diff -ur scratch-1.4.0.6.src.orig/src/scratch scratch-1.4.0.6.src/src/scratch
+--- scratch-1.4.0.6.src.orig/src/scratch       2011-07-01 18:21:32.000000000 
-0400
++++ scratch-1.4.0.6.src/src/scratch    2012-09-10 09:39:20.555278005 -0400
+@@ -4,11 +4,9 @@
+ # Original Author: Bert Freudenberg
+ # Adapted by:      Miriam Ruiz
+ 
+-VM_VERSION=`find /usr/lib/squeak/ -name "squeakvm" -type f|cut -f5 -d"/"`
+-SQ_DIR=/usr/lib/squeak/$VM_VERSION
+-VM="$SQ_DIR/squeakvm"
+-VMOPTIONS="-encoding UTF-8 -vm-display-x11 -xshm -plugins 
/usr/lib/scratch/Plugins/:$SQ_DIR/"
+-IMAGE="/usr/lib/scratch/Scratch.image"
++VM="/usr/bin/squeak"
++VMOPTIONS="-encoding UTF-8"
++IMAGE="/usr/share/scratch/Scratch.image"
+ IMOPTIONS=""
+ DOCUMENT=""
+ WRAPPER=""
-- 
2.9.3