Subject: [PATCH 2/2] UNFINISHED gnu: Add G-Golf's GTK-4 examples.

From: Florian Pelz <[email-masked]>
Date: Thu, 13 Feb 2025 03:55:13 +0100

From: "pelzflorian (Florian Pelz)" <[email-masked]>

* gnu/packages/guile-xyz.scm (g-golf-gtk-4-examples): New variable.

Change-Id: I19b182eb71095ca2deacdb4011c8f50dfcfc8476
---
 gnu/packages/guile-xyz.scm | 73 ++++++++++++++++++++++++++++++++++++++
 1 file changed, 73 insertions(+)

diff --git a/gnu/packages/guile-xyz.scm b/gnu/packages/guile-xyz.scm
index 92d5d90194..520d1b9f87 100644
--- a/gnu/packages/guile-xyz.scm
+++ b/gnu/packages/guile-xyz.scm
@@ -53,6 +53,7 @@
 ;;; Copyright © 2024 Alec Barreto <[email-masked]>
 ;;; Copyright © 2024 Josep Bigorra <[email-masked]>
 ;;; Copyright © 2024 Ashish SHUKLA <[email-masked]>
+;;; Copyright © 2025 Florian Pelz <[email-masked]>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -2618,6 +2619,78 @@ (define-public guile2.2-g-golf
        (replace "guile" guile-2.2)
        (replace "guile-lib" guile2.2-lib)))))
 
+(define-public g-golf-gtk-4-examples
+  (package
+    (inherit guile-g-golf)
+    (name "g-golf-gtk-4-examples")
+    (arguments
+     (list
+      #:modules `(((guix build guile-build-system)
+                   #:select
+                   (target-guile-effective-version))
+                  ,@%default-gnu-modules)
+      #:tests? #f ;there are no tests for examples
+      ;; XXX: Maybe Guix should ship a reftest on its own?
+      #:phases
+      (with-imported-modules `((guix build guile-build-system)
+                               ,@%default-gnu-imported-modules)
+        #~(modify-phases %standard-phases
+            (add-after 'unpack 'prepare-examples
+              (lambda _
+                (chdir "examples/gtk-4")
+                ;; Re-use the existing Makefile for its wildcard syntax.
+                (rename-file "Makefile.am" "Makefile")
+                ;; Add a rule to install the examples.  This also
+                ;; installs UI, CSS and Scheme files to /bin, but
+                ;; better keep how G-Golf packages them.
+                (let ((port (open-file "Makefile" "al")))
+                  (format port "
+prefix = ~a
+bindir = $(prefix)/bin
+.PHONY: install
+install:
+	mkdir -p $(bindir)
+	for f in $(EXTRA_DIST); do	\\
+	  install $$f $(bindir);	\\
+	done
+" #$output)
+                  (close-port port))))
+            (delete 'configure)
+            (add-after 'install 'wrap-binaries
+              (lambda* (#:key inputs #:allow-other-keys)
+                (let* ((version (target-guile-effective-version))
+                       (g-golf (assoc-ref inputs "guile-g-golf"))
+                       (scm (string-append "/share/guile/site/" version))
+                       (go (string-append "/lib/guile/"
+                                          version "/site-ccache"))
+                       (binaries
+                        (find-files "." (lambda (file stat) ;only executables
+                                          (= (stat:perms stat) #o755)))))
+                  (map (lambda (binary)
+                         ;; The `current-filename' calls in examples are broken.
+                         (system* "sed" "-i" "s/(add-to-load-path.*//g" binary)
+                         ;;TODO DOES NOT WORK (substitute* binary
+                         ;;   (("add-to-load-path.*")
+                         ;;    ""))  DOES NOT WORK NEITHER
+                         (wrap-program (string-append #$output "/bin/" binary)
+                           `("GUILE_LOAD_PATH" prefix
+                             (,(string-append g-golf scm)
+                              ));,(string-append #$output "/bin"))) ;not nice,
+                                ;        ;but better than `add-to-load-path'
+                           `("GUILE_LOAD_COMPILED_PATH" prefix
+                             (,(string-append g-golf go)))
+                           `("GI_TYPELIB_PATH" prefix
+                             (,(getenv "GI_TYPELIB_PATH")))))
+                       binaries))))))))
+    (inputs
+     (list bash-minimal gtk guile-3.0 guile-cairo-next guile-g-golf))
+    (native-inputs (list))
+    (propagated-inputs (list))
+    (synopsis "Example GTK apps written in Guile with G-Golf")
+    (description
+     "Example applications to show what can be done in G-Golf and how to wrap
+the applications in a Guix package.")))
+
 (define-public g-wrap
   (package
     (name "g-wrap")
-- 
2.48.1