From patchwork Tue Feb 18 17:13:28 2025 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 8bit X-Patchwork-Submitter: "pelzflorian (Florian Pelz)" X-Patchwork-Id: 38830 Return-Path: X-Original-To: patchwork@mira.cbaines.net Delivered-To: patchwork@mira.cbaines.net Received: by mira.cbaines.net (Postfix, from userid 113) id 0C96227BBEA; Tue, 18 Feb 2025 17:14:54 +0000 (GMT) X-Spam-Checker-Version: SpamAssassin 3.4.6 (2021-04-09) on mira.cbaines.net X-Spam-Level: X-Spam-Status: No, score=-7.6 required=5.0 tests=BAYES_00,DKIMWL_WL_HIGH, DKIM_SIGNED,DKIM_VALID,MAILING_LIST_MULTI,RCVD_IN_DNSWL_BLOCKED, RCVD_IN_VALIDITY_CERTIFIED,RCVD_IN_VALIDITY_RPBL,RCVD_IN_VALIDITY_SAFE, SPF_HELO_PASS,URIBL_BLOCKED autolearn=ham autolearn_force=no version=3.4.6 Received: from lists.gnu.org (lists.gnu.org [209.51.188.17]) by mira.cbaines.net (Postfix) with ESMTPS id 3791027BBE2 for ; Tue, 18 Feb 2025 17:14:53 +0000 (GMT) Received: from localhost ([::1] helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1tkRAq-0000ut-4L; Tue, 18 Feb 2025 12:14:20 -0500 Received: from eggs.gnu.org ([2001:470:142:3::10]) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1tkRAZ-0000rY-Ih for guix-patches@gnu.org; Tue, 18 Feb 2025 12:14:03 -0500 Received: from debbugs.gnu.org ([2001:470:142:5::43]) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1tkRAZ-0006nW-9z for guix-patches@gnu.org; Tue, 18 Feb 2025 12:14:03 -0500 DKIM-Signature: v=1; a=rsa-sha256; q=dns/txt; c=relaxed/relaxed; d=debbugs.gnu.org; s=debbugs-gnu-org; h=MIME-Version:References:In-Reply-To:Date:From:To:Subject; bh=p74/1M7hkjGU58cBRsD7Kdn/pDAjzifqkoPIBXCGuKQ=; b=jYzs/y37sda4dXdwpfdRwC26diDKRX3f2+6PnbbfvQ22fyIisAOJJVZJnzLN0+gJkDIqEJgDV7+l5hwqr+QNhx/EQIjhPG9r0UNYYRMVFTYGigTLPyvDRhdFM5QFwH33A6sgtgOXTVNHs1JgN615j8/mdZRCTHYNbjloXN7x2/SHVBPx/6Yu7e08dgj0oXRezLCfV96o0gp2TvWvg9xLBEvWrAM25wQPfSiVeoXYRugfhEB/nVtwNUq0oyDQTkhIjiUlkkKJHamqgggmJexhPDuuWLT+z+cedU8R8kjOCNk8TTpKxTNbP3fMhAgHYcNne6nhBM9CW3Rd+rUguZXM7w==; Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1tkRAZ-00004t-50 for guix-patches@gnu.org; Tue, 18 Feb 2025 12:14:03 -0500 X-Loop: help-debbugs@gnu.org Subject: [bug#76246] [PATCH v5 4/6] gnu: Add G-Golf's GTK-4 examples. Resent-From: Florian Pelz Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Tue, 18 Feb 2025 17:14:03 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 76246 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch To: 76246@debbugs.gnu.org Cc: Florian Pelz Received: via spool by 76246-submit@debbugs.gnu.org id=B76246.173989883532705 (code B ref 76246); Tue, 18 Feb 2025 17:14:03 +0000 Received: (at 76246) by debbugs.gnu.org; 18 Feb 2025 17:13:55 +0000 Received: from localhost ([127.0.0.1]:60307 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1tkRAM-0008V5-Ri for submit@debbugs.gnu.org; Tue, 18 Feb 2025 12:13:55 -0500 Received: from relay.yourmailgateway.de ([194.59.206.189]:35673) by debbugs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.84_2) (envelope-from ) id 1tkRAJ-0008Up-Is for 76246@debbugs.gnu.org; Tue, 18 Feb 2025 12:13:48 -0500 Received: from relay02-mors.netcup.net (localhost [127.0.0.1]) by relay02-mors.netcup.net (Postfix) with ESMTPS id 4Yy5hp1Vhxz47bS for <76246@debbugs.gnu.org>; Tue, 18 Feb 2025 18:13:46 +0100 (CET) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/simple; d=pelzflorian.de; s=key2; t=1739898826; bh=ii0jJfb/6ho5vKuW3pMGflx66fdMWJXYBIOVeJaz58U=; h=From:To:Cc:Subject:Date:In-Reply-To:References:From; b=gvdAbPc2d+T9ThwpVDYH7Nn79t/ID8IfHwhfcRBEhz+U/BPItZgNDU7YoDbgpBOVd SMoIJ4YHcEkNuXs0zFyNiJGI2haGU1ryYEdjGgLDAYHqRw6/PWLpOwYjPLXvHtKxzO ZpO+dCRIXMB7gxS4ZdRumGWCaG8Gh6CZf6II+Ttd7dtntPqNoAlro7WJAa3oU30D2Z pJbY6Z+FbHWG1Shpga8xDG2fIJONofkDK/LfauuzLqkDvS+EUphWj6QYDUQt//uVeh r+J7QVXCJhVYbHoGR48nAZhhDnxBxe1RDUqop4+XviXAzgz0hJkQWNw77MUovr6X9N zhlhMD25cyHNw== Received: from policy02-mors.netcup.net (unknown [46.38.225.35]) by relay02-mors.netcup.net (Postfix) with ESMTPS id 4Yy5hp175gz7wnT for <76246@debbugs.gnu.org>; Tue, 18 Feb 2025 18:13:46 +0100 (CET) Received: from mxe217.netcup.net (unknown [10.243.12.53]) (using TLSv1.2 with cipher ECDHE-RSA-AES256-GCM-SHA384 (256/256 bits)) (No client certificate requested) by policy02-mors.netcup.net (Postfix) with ESMTPS id 4Yy5hn6qfwz8sb8 for <76246@debbugs.gnu.org>; Tue, 18 Feb 2025 18:13:45 +0100 (CET) Received: from florianhp.fritz.box (ipb21a5dbf.dynamic.kabel-deutschland.de [178.26.93.191]) by mxe217.netcup.net (Postfix) with ESMTPSA id 93CBA84631; Tue, 18 Feb 2025 18:13:40 +0100 (CET) From: Florian Pelz Date: Tue, 18 Feb 2025 18:13:28 +0100 Message-ID: <103b82ca676b12e0098627f703641d0fe5f41dc6.1739898237.git.pelzflorian@pelzflorian.de> X-Mailer: git-send-email 2.48.1 In-Reply-To: References: MIME-Version: 1.0 X-Rspamd-Queue-Id: 93CBA84631 X-Rspamd-Server: rspamd-worker-8404 X-NC-CID: 5KG/UQZG3z1nq/qncuqFC6zYYTYXiC6v8qPITLZ883uPXp7HC7/uAjG5 X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-BeenThere: guix-patches@gnu.org List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guix-patches-bounces+patchwork=mira.cbaines.net@gnu.org Sender: guix-patches-bounces+patchwork=mira.cbaines.net@gnu.org X-getmail-retrieved-from-mailbox: Patches * gnu/packages/guile-xyz.scm (g-golf-gtk-4-examples): New variable. Change-Id: I19b182eb71095ca2deacdb4011c8f50dfcfc8476 --- gnu/packages/guile-xyz.scm | 190 +++++++++++++++++++++++++++++++++++++ 1 file changed, 190 insertions(+) diff --git a/gnu/packages/guile-xyz.scm b/gnu/packages/guile-xyz.scm index 8fb4448061..0c7329c7ea 100644 --- a/gnu/packages/guile-xyz.scm +++ b/gnu/packages/guile-xyz.scm @@ -53,6 +53,7 @@ ;;; Copyright © 2024 Alec Barreto ;;; Copyright © 2024 Josep Bigorra ;;; Copyright © 2024 Ashish SHUKLA +;;; Copyright © 2025 Florian Pelz ;;; ;;; This file is part of GNU Guix. ;;; @@ -2623,6 +2624,195 @@ (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)) + (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/gtk-4") + ;; Re-use the existing Makefile for its wildcard syntax. + (rename-file "Makefile.am" "Makefile") + ;; Add a rule to install the examples. We install to the + ;; documentation directory where examples are usually located, + ;; but we will later create a copy in /bin for `guix shell'. + (let ((port (open-file "Makefile" "al"))) + (format port " +prefix = ~a +bindir = $(prefix)/bin +examplesdir = $(prefix)/share/doc/g-golf/examples/gtk-4 +.PHONY: install +install: + mkdir -p $(bindir) + mkdir -p $(examplesdir)/css + mkdir -p $(examplesdir)/demos + mkdir -p $(examplesdir)/images + mkdir -p $(examplesdir)/ui + for f in $(EXTRA_DIST); do \\ + cp $$f $(examplesdir)/$$f; \\ + done + install demos/libfpt.so $(examplesdir)/demos +" #$output) + (close-port port)))) + (delete 'configure) + (replace 'build + (lambda _ + ;; The layout-manager-2 example calls `make', GCC at run-time. + ;; But since it would compile to the read-only /gnu/store, we + ;; deviate by compiling in advance in the build phase, + ;; ignoring failing `make' calls. We do not propagate `make'. + (with-directory-excursion "demos" + (when #$(%current-target-system) + (substitute* "Makefile" + (("^CC = gcc$") + (string-append "CC = " #$(cc-for-target) "\n")))) + (system* "make")))) + ;; There are no tests for examples, but we do an installcheck phase, + ;; which respects when #:tests? is turned off. So delete 'check. + (delete 'check) + (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 "\ +/share/doc/g-golf/examples/gtk-4/" binary))) + (substitute* binary + (("\\(current-filename\\)") + (string-append "\"" installed-binary "\"")) + (("\\(getcwd\\)") + (string-append "\"" #$output "\ +/share/doc/g-golf/examples/gtk-4\"")) + (("^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")) + (gcairo (assoc-ref inputs "guile-cairo-next")) + (adwaita-icons (assoc-ref inputs "adwaita-icon-theme")) + (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 "/\ +share/doc/g-golf/examples/gtk-4/" binary))) + (wrap-program installed-binary + `("GUILE_LOAD_PATH" prefix + (,(string-append g-golf scm) + ,(string-append gcairo scm))) + `("GUILE_LOAD_COMPILED_PATH" prefix + (,(string-append g-golf go) + ,(string-append gcairo go))) + `("GI_TYPELIB_PATH" prefix + (,(getenv "GI_TYPELIB_PATH"))) + ;; Library path for libraries loaded by binaries. + `("LD_LIBRARY_PATH" prefix + (,(string-append gcairo "/lib"))) + `("XDG_DATA_DIRS" suffix + (,(string-append adwaita-icons "/share")))) + ;; Also create a copy in /bin for `guix shell'. + (copy-file installed-binary + (string-append #$output "/bin/" binary)))) + binaries)))) + ;; Add installcheck to ensure nothing breaks. + (add-after 'strip 'installcheck + (lambda* (#:key inputs tests? #:allow-other-keys) + (cond + ((not tests?) + (display "test suite not run\n")) + (#$(%current-target-system) + (display "cross-compiling; reftest skipped\n")) + (else + ;; Start an X server. + (system "Xvfb :1 &") + (setenv "DISPLAY" ":1") + (let* ((g-golf-drawing (string-append + #$output "\ +/share/doc/g-golf/examples/gtk-4/drawing-widget")) + (pid (spawn g-golf-drawing `(,g-golf-drawing) + #:search-path? #f))) + (sleep 10) ;2s is enough on my machine + (display "Taking a screenshot with G-Golf.\n") + (system* "import" "-window" "root" + "drawing-widget.out.png") + (sleep 5) ;1s is enough on my machine + (kill pid SIGINT) + (waitpid pid)) + (let* ((python (search-input-file inputs "/bin/python3")) + (pygobject-drawing #$(this-package-native-input + "drawing-widget.py")) + (pid (spawn python `(,python ,pygobject-drawing) + #:search-path? #f))) + (sleep 5) ;1s is enough on my machine + (display "Taking a screenshot with Pygobject.\n") + (system* "import" "-window" "root" + "drawing-widget.ref.png") + (sleep 5) + (kill pid SIGINT) + (waitpid pid)) + (if (= (pk (system* "compare" "-metric" "AE" "-fuzz" "1%" + "drawing-widget.out.png" + "drawing-widget.ref.png" + "drawing-widget.dif.png")) 0) + (display "All good; they look the same.\n") + (error "Reftest failed; screenshots differ.")))))))))) + (inputs + (list adwaita-icon-theme + bash-minimal + gtk + guile-3.0 + guile-cairo-next + guile-g-golf)) + (native-inputs + (list pkg-config + which + ;; For installcheck: + imagemagick + python-minimal + python-pygobject + xorg-server-for-tests + ;; Python version of drawing-widget from + ;; https://lists.gnu.org/archive/html/guile-user/2024-05/msg00032.html + (origin + (method url-fetch) + (uri "\ +https://lists.gnu.org/archive/html/guile-user/2024-05/txtT_80XuINsX.txt") + (sha256 + (base32 + "07j2v159a3bb99i8kwbqrcgslcmhhnqa5ah53q2b9bdk8042grsx")) + (file-name "drawing-widget.py")))) + (propagated-inputs (list)) + (synopsis "Example GTK 4 apps written in Guile with G-Golf") + (description + "G-Golf port of (a subset of) the upstream @code{gtk4-demo} examples in +the @code{gtk:bin} Guix package output. Run @command{guix edit +g-golf-gtk-4-examples} for inspiration how to wrap G-Golf applications when +writing a Guix package."))) + (define-public g-wrap (package (name "g-wrap")