Package: guix-patches;
Reported by: Florian Pelz <pelzflorian <at> pelzflorian.de>
Date: Thu, 13 Feb 2025 02:51:01 UTC
Severity: normal
Tags: patch
Done: "pelzflorian (Florian Pelz)" <pelzflorian <at> pelzflorian.de>
Bug is archived. No further changes may be made.
Message #77 received at 76246 <at> debbugs.gnu.org (full text, mbox):
From: Florian Pelz <pelzflorian <at> pelzflorian.de> To: 76246 <at> debbugs.gnu.org Cc: Florian Pelz <pelzflorian <at> pelzflorian.de> Subject: [PATCH v4 5/5] gnu: Add G-Golf's Adw-1 examples. Date: Mon, 17 Feb 2025 12:05:41 +0100
* gnu/packages/guile-xyz.scm (g-golf-adw-1-examples): New variable.
Change-Id: I160e58ceaeb4867f9b21a0a32f198113e36b5c88
---
gnu/packages/guile-xyz.scm | 126 +++++++++++++++++++++++++++++++++++++
1 file changed, 126 insertions(+)
diff --git a/gnu/packages/guile-xyz.scm b/gnu/packages/guile-xyz.scm
index 6e53bc291f..130652fb23 100644
--- a/gnu/packages/guile-xyz.scm
+++ b/gnu/packages/guile-xyz.scm
@@ -2804,6 +2804,132 @@ (define-public g-golf-gtk-4-examples
g-golf-gtk-4-examples} for inspiration how to wrap G-Golf applications when
writing a Guix package.")))
+(define-public g-golf-adw-1-examples
+ (package
+ (inherit guile-g-golf)
+ (name "g-golf-adw-1-examples")
+ (build-system glib-or-gtk-build-system)
+ (arguments
+ (list
+ #:tests? #f ;there are no tests for examples
+ #:modules `(((guix build guile-build-system)
+ #:select
+ (target-guile-effective-version))
+ (guix build glib-or-gtk-build-system)
+ (srfi srfi-26)
+ ,@%default-gnu-modules)
+ #: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/adw-1")
+ ;; Re-use the existing Makefile for its wildcard syntax.
+ (rename-file "Makefile.am" "Makefile")
+ (substitute* "Makefile"
+ ;; Fix syntax error.
+ (("hello-world")
+ "hello-world \\"))
+ ;; 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)/demo/icons
+ mkdir -p $(bindir)/demo/pages
+ for f in $(EXTRA_DIST); do \\
+ cp -r $$f $(bindir)/$$f; \\
+ done
+ cp demo/g-resources $(bindir)/demo/g-resources
+" #$output)
+ (close-port port))))
+ (delete 'configure)
+ (replace 'build
+ (lambda _
+ ;; Create files for adwaita-1-demo needed in install phase.
+ (with-directory-excursion "demo"
+ (system* "make")
+ (system* "glib-compile-resources"
+ "--target" "g-resources"
+ "g-resources.xml"))))
+ (add-before 'install 'patch-scm-files
+ (lambda* (#:key inputs #:allow-other-keys)
+ ;; `current-filename' calls in examples are broken.
+ (map (lambda (binary)
+ (let ((installed-binary (string-append
+ #$output "/bin/" binary)))
+ (substitute* binary
+ (("\\(current-filename\\)")
+ (string-append "\"" installed-binary "\""))
+ (("^exec guile ")
+ (string-append
+ "exec " (search-input-file inputs "/bin/guile")
+ " ")))))
+ (map (cut string-drop <> 2) ;strip ./ prefix
+ (find-files "." (lambda (file stat)
+ ;executables or .scm modules
+ (or (= (stat:perms stat) #o755)
+ (string-suffix? ".scm"
+ file))))))))
+ (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"))
+ (adwaita-icons (assoc-ref inputs "adwaita-icon-theme"))
+ (libadwaita-icons (assoc-ref inputs "libadwaita"))
+ (scm (string-append "/share/guile/site/" version))
+ (go (string-append "/lib/guile/"
+ version "/site-ccache"))
+ (binaries
+ (find-files "." (lambda (file stat) ;executables
+ (= (stat:perms stat) #o755)))))
+ (map (lambda (binary)
+ (let ((installed-binary (string-append
+ #$output "/bin/" binary)))
+ (wrap-program installed-binary
+ `("GUILE_LOAD_PATH" prefix
+ (,(string-append g-golf scm)))
+ `("GUILE_LOAD_COMPILED_PATH" prefix
+ (,(string-append g-golf go)))
+ `("GI_TYPELIB_PATH" prefix
+ (,(getenv "GI_TYPELIB_PATH")))
+ `("GUIX_GDK_PIXBUF_MODULE_FILES" suffix
+ (,(getenv "GUIX_GDK_PIXBUF_MODULE_FILES")))
+ `("XDG_DATA_DIRS" suffix
+ (,(string-append #$output "/bin/demo")
+ ,(string-append adwaita-icons "/share")
+ ,(string-append libadwaita-icons "/share"))))))
+ binaries))))
+ (add-after 'wrap-binaries 'move-binaries
+ (lambda _
+ ;; Move the adwaita-1-demo wrapper to place it directly in /bin.
+ (rename-file (string-append
+ #$output "/bin/demo/adwaita-1-demo")
+ (string-append
+ #$output "/bin/adwaita-1-demo"))))))))
+ (inputs
+ (list adwaita-icon-theme
+ bash-minimal
+ libadwaita
+ (librsvg-for-system)
+ gtk
+ guile-3.0
+ guile-g-golf))
+ (native-inputs (list `(,glib "bin") ;for glib-compile-resources
+ guile-3.0))
+ (propagated-inputs (list))
+ (synopsis "Example Adwaita 1 apps written in Guile with G-Golf")
+ (description
+ "G-Golf port of (a subset of) the upstream @code{adwaita-1-demo} examples
+in the @code{libadwaita} Guix package. Run @command{guix edit
+g-golf-adw-1-examples} for inspiration how to wrap G-Golf applications when
+writing a Guix package.")))
+
(define-public g-wrap
(package
(name "g-wrap")
--
2.48.1
GNU bug tracking system
Copyright (C) 1999 Darren O. Benham,
1997,2003 nCipher Corporation Ltd,
1994-97 Ian Jackson.