[bug#76246,2/2] UNFINISHED gnu: Add G-Golf's GTK-4 examples.
Commit Message
From: "pelzflorian (Florian Pelz)" <pelzflorian@pelzflorian.de>
* 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(+)
@@ -53,6 +53,7 @@
;;; Copyright © 2024 Alec Barreto <mrh57@posteo.net>
;;; Copyright © 2024 Josep Bigorra <jjbigorra@gmail.com>
;;; Copyright © 2024 Ashish SHUKLA <ashish.is@lostca.se>
+;;; Copyright © 2025 Florian Pelz <pelzflorian@pelzflorian.de>
;;;
;;; 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")