Re: GNU G-Golf 0.8.0-rc6 available for testing
"pelzflorian (Florian Pelz)" <[email protected]>
| Newsgroups | gmane.lisp.guile.user |
|---|---|
| Message-ID | <[email protected]> |
Thank you David for this release!
G-Golf works great. Now I can embed GTK programs within the Guix Home
configurations of my family’s media center mini PC, without writing C
(see attached file). All system setup is in Guile. Note that this is
not pure Guix, but on top of my Guix channel git repo, I have applied
Arnaud’s Sway patch [1]. Also I have a custom configuration of the
operating-system’s sudoers file [2].
All that is left is that I do not understand why
(gdk-display-get-default) returns #f in G-Golf but
gdk_display_get_default () in C returns 0x1c0e36c0.
Regards,
Florian
[1]
https://issues.guix.gnu.org/72714
[2]
(sudoers-file
(plain-file "sudoers"
(string-append (plain-file-content %sudoers-specification)
(format #f "\
Cmnd_Alias SHUTDOWN_CMDS = \
/run/current-system/profile/sbin/halt, \
/run/current-system/profile/sbin/reboot, \
/run/privileged/bin/mount ~%\
user ALL = (ALL) NOPASSWD: SHUTDOWN_CMDS~%"))))
home-configuration.scm
(text/plain, 9.9 KB)
;;; Copyright © 2023, 2024 Florian Pelz <[email protected]> ;; ;; This program is free software: you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation, either version 3 of the License, or ;; (at your option) any later version. ;; ;; This program is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; ;; You should have received a copy of the GNU General Public License ;; along with this program. If not, see <http://www.gnu.org/licenses/>. ;; ;; Dieses Programm ist Freie Software: Sie können es unter den Bedingungen ;; der GNU General Public License, wie von der Free Software Foundation, ;; Version 3 der Lizenz oder (nach Ihrer Wahl) jeder neueren ;; veröffentlichten Version, weiter verteilen und/oder modifizieren. ;; ;; Dieses Programm wird in der Hoffnung bereitgestellt, dass es nützlich sein wird, jedoch ;; OHNE JEDE GEWÄHR,; sogar ohne die implizite ;; Gewähr der MARKTFÄHIGKEIT oder EIGNUNG FÜR EINEN BESTIMMTEN ZWECK. ;; Siehe die GNU General Public License für weitere Einzelheiten. ;; ;; Sie sollten eine Kopie der GNU General Public License zusammen mit diesem ;; Programm erhalten haben. Wenn nicht, siehe <https://www.gnu.org/licenses/>. (use-modules (gnu home) (gnu home services) (gnu home services desktop) (gnu home services shells) (gnu home services sound) (gnu home services sway) (gnu packages) (gnu packages gtk) (gnu packages guile-xyz) (gnu services) (guix build-system glib-or-gtk) (guix gexp) (guix licenses) (guix packages) (guix transformations)) (home-environment (packages (specifications->packages (list "git"))) (services (list (service home-bash-service-type) (service home-dbus-service-type) ;für VLC ;; (service home-pipewire-service-type) (service home-sway-service-type (sway-configuration (execs `(,(with-extensions (list graphene gtk ((options->transformation '((with-commit . "guile-g-golf=v0.8.0-rc6"))) guile-g-golf)) #~(string-append "guile " #$(scheme-file "launcher.scm" #~(begin (eval-when (expand load eval) (use-modules (oop goops)) (default-duplicate-binding-handler '(merge-generics replace warn-override-core warn last)) (setenv "GI_TYPELIB_PATH" #$(file-append (directory-union "typelibs" (list gdk-pixbuf graphene gtk harfbuzz pango)) "/lib/girepository-1.0")) (use-modules (g-golf)) (g-irepository-require "Gtk" #:version "4.0") (for-each (lambda (name) (gi-import-by-name "Gtk" name)) '("Application" "ApplicationWindow" "Builder" "CssProvider" ))) (use-modules (sxml simple)) (define ui '(interface (requires (@ (version 4.0) (lib gtk))) (object (@ (id window) (class GtkApplicationWindow)) (child (object (@ (class GtkGrid)) (property (@ (name row-homogeneous)) 1) (property (@ (name column-homogeneous)) 1) (child (object (@ (id btn-kodi) (class GtkButton)) (property (@ (name label)) Kodi) (layout (property (@ (name column)) 0) (property (@ (name row)) 0)))) (child (object (@ (id btn-halt) (class GtkButton)) (property (@ (name label)) Halt) (layout (property (@ (name column)) 0) (property (@ (name row)) 1)))) (child (object (@ (id btn-reboot) (class GtkButton)) (property (@ (name label)) Reboot) (layout (property (@ (name column)) 1) (property (@ (name row)) 1)))) (child (object (@ (id btn-mount) (class GtkButton)) (property (@ (name label)) Mounten) (layout (property (@ (name column)) 1) (property (@ (name row)) 0))))))))) (define provider (make <gtk-css-provider>)) (define (mount-all) (gtk-css-provider-load-from-string provider "\ .reddable label { background-color: red; } ") (unless (= 0 (system "\ sudo /run/privileged/bin/mount \ /dev/disk/by-id/usb-WD_Elements_25A3_574343374B31544434313530-0:0-part1 \ /media/WDElements/")) (gtk-style-context-add-provider-for-display (pk(gdk-display-get-default)) provider 100))) (define (activate app) (let ((builder (make <gtk-builder>))) (define (get str) (get-object builder str)) (add-from-string builder (with-output-to-string (lambda () (sxml->xml ui))) -1) (let ((window (get "window")) (btn-kodi (get "btn-kodi")) (btn-mount (get "btn-mount")) (btn-halt (get "btn-halt")) (btn-reboot (get "btn-reboot"))) (connect btn-kodi 'clicked (lambda (b) (gtk-widget-hide window) (system (string-append "\ /var/guix/profiles/per-user/florian/current-guix/bin/guix \ shell --container --network --no-cwd flatpak \ --expose=/home/user/.local/share/flatpak/ \ --share=/home/user/you-kodi/.kodi=/home/user/.var/app/tv.kodi.Kodi/data \ --expose=/sys \ --preserve='^DBUS_.*' \ --share=/media/WDElements \ --expose=/dev/dri --expose=" "/run/user/1001";(getenv "XDG_RUNTIME_DIR") "/bus=/var/run/dbus/system_bus_socket --expose=/dev/dri --expose=/dev/snd \ --preserve='^DISPLAY$' -- flatpak run -v tv.kodi.Kodi --audio-backend=alsa")) (present window))) (connect btn-mount 'clicked (lambda (b) (mount-all))) (connect btn-halt 'clicked (lambda (b) (system "\ sudo /run/current-system/profile/sbin/halt"))) (connect btn-reboot 'clicked (lambda (b) (system "\ sudo /run/current-system/profile/sbin/reboot"))) (add-window app window) (present window)))) (let ((app (make <gtk-application> #:application-id "my.launcher"))) (mount-all) (connect app 'activate activate) (let ((status (g-application-run app '()))) (exit status status))))) " 2>&1 | tee /home/user/errors")))))) (simple-service 'gtk-config-service home-xdg-configuration-files-service-type `(("gtk-4.0/settings.ini" ,(mixed-text-file "gtk-config" "\ [Settings] gtk-xft-dpi=500000 ")))))))