~hutzdog/patchwork

404c5e97ed40a1d8585f151cc6497b4e229d7efb — hutzdog@proton.me 3 months ago 7732020
Publish the Hyprland package
M patchwork/channels.scm => patchwork/channels.scm +6 -29
@@ 1,9 1,9 @@
;;; The channels officially supported by PatchworkOS (only free channels are allowed)
(define-module (patchwork channels)
  #:use-module (guix records)
  #:use-module (guix channels)
  #:export (%guix-channel
            %nonguix-channel
            %gaming-channel
            %patchworkos-channel

            channel-config
            make-channel-config


@@ 38,39 38,16 @@
     (openpgp-fingerprint
      "42A0 878E CF99 B2E5 C941  8771 288B EB04 6FC3 AF7E")))))

;;; The Nonguix unfree repos (provided for those who need it)
;;; TODO: remove from this repo and make separate nonfree channel
(define %nonguix-channel
  (channel
   (name 'nonguix)
   (url "https://gitlab.com/nonguix/nonguix")
   (branch "master")
   (introduction
     (make-channel-introduction
       "897c1a470da759236cc11798f4e0a5f7d4d59fbc"
       (openpgp-fingerprint
         "2A39 3FFF 68F4 EF7A 3D29  12AF 6F51 20A0 22FB B2D5")))))

;;; The Guix gaming unfree repos (provided for those who need it)
(define %gaming-channel
  (channel
    (name 'guix-gaming-games)
    (url "https://gitlab.com/guix-gaming-channels/games.git")
    ;; Enable signature verification:
    (introduction
      (make-channel-introduction
        "c23d64f1b8cc086659f8781b27ab6c7314c5cca5"
        (openpgp-fingerprint
          "50F3 3E2E 5B0C 3D90 0424  ABE8 9BDC F497 A4BB CC7F")))))

;;; A configuration for Guix channels
(define-record-type* <channel-config> channel-config
 make-channel-config
 channel-config?
 (guix channel-guix (default %guix-channel))
 (patchwork channel-patchwork (default %patchworkos-channel))
 (others channel-others (default '())))

;;; Convert a channel-config into the format used bu channels.scm
(define (channel-config->channels channels)
 (cons* (channel-guix channels)
        (channel-others channels)))
  (cons* (channel-guix channels)
         (channel-patchwork channels)
         (channel-others channels)))

A patchwork/packages/desktop.scm => patchwork/packages/desktop.scm +204 -0
@@ 0,0 1,204 @@
;;; Desktop packages for PatchworkOS
(define-module (patchwork packages desktop)
  #:use-module (gnu packages admin)
  #:use-module (gnu packages cmake)
  #:use-module (gnu packages commencement)
  #:use-module (gnu packages freedesktop)
  #:use-module (gnu packages gl)
  #:use-module (gnu packages glib)
  #:use-module (gnu packages gtk)
  #:use-module (gnu packages linux)
  #:use-module (gnu packages pciutils)
  #:use-module (gnu packages pkg-config)
  #:use-module (gnu packages python)
  #:use-module (gnu packages qt)
  #:use-module (gnu packages web)
  #:use-module (gnu packages wm)
  #:use-module (gnu packages xdisorg)
  #:use-module (gnu packages xorg)
  #:use-module (guix build utils)
  #:use-module (guix build-system cmake)
  #:use-module (guix build-system meson)
  #:use-module (guix download)
  #:use-module (guix gexp)
  #:use-module (guix git-download)
  #:use-module (guix licenses)
  #:use-module (guix packages))

;; HYPRLAND / DEPENDENCIES (TODO: contribute upstream)
;;; A lot of these just need to be merged into mainline Guix (version bumps mostly), though there are a few that need better implementations first
;;; Fixes needed before upstream contribution:
;;; - Hwdata input splitting (or discuss removing the splitting, or use the wlroots patch)
;;; - Cairo needs to be fully migrated over to Meson
;; TODO: wait for libinput to be updated in Guix (patch already exists)
(define-public libinput-1.25
  (package
   (inherit libinput)
   (version "1.25.0")
   (source (origin
            (method url-fetch)
            (uri (string-append
                  "https://gitlab.freedesktop.org/libinput/libinput/-/archive/"
                  version "/libinput-" version ".tar.bz2"))
            (sha256 (base64 "GTvVkimL2eNpwO8+XYOmqdaN3EzT38hLvneSCo0NV98="))))
   (arguments (append (package-arguments libinput)
                      '(#:tests? #f)))))

;; TODO: wait for libdrm to be updated in Guix (patch already exists)
(define-public libdrm-2.4.120
  (package
   (inherit libdrm)
   (version "2.4.120")
   (source (origin
            (method url-fetch)
            (uri (string-append
                    "https://dri.freedesktop.org/libdrm/libdrm-"
                    version ".tar.xz"))
            (sha256 (base64 "O/VTY/dsclCUZEGrUdOmzArlGAVcD/AXMkq3bN77Mno="))))))

;; TODO: wait for Cairo to be updated in Guix (need to make patch, will do so after Patchwork is out)
(define-public cairo-1.18
  (package
   (inherit cairo)
   (version "1.18.0")
   (source (origin
            (method url-fetch)
            (uri (string-append
                  "https://cairographics.org/releases/cairo-"
                  version ".tar.xz"))
            (sha256 (base64 "JDoHNrl4oz3uKfnMp1IXM7eKZbVBggb+970cPUzxC2Q="))))
   (build-system meson-build-system)
   ;; TODO: make compatible with documentation generation
   (outputs '("out"))
   (arguments `(#:tests? #f
                #:configure-flags
                (list
                 "-Dtee=enabled"
                 "-Dzlib=enabled"
                 "-Dtests=disabled")))))

;; TODO: Wait for Guix hwdata to support pkg-config
;; This version of hwdata has all outputs joined into one so that the pkg-config script works
;; This cannot be upstreamed without modification, as it only can have 1 output. Either Hyprland will need to be patched, an aggregate package gets pushed to Guix that propogates all outputs, or some other solution will need to be found
(define-public hwdata-pkg-config
  (package
   (inherit hwdata)
   (outputs '("out"))

   ;; HACK: this depends on #:phases being the last argument, I need to find a better way to do this
   (arguments
    (append (reverse (cddr (reverse (package-arguments hwdata))))
            (list
             #:phases
              #~(modify-phases
                 %standard-phases
                 (add-after 'build 'pkg-config
                            (lambda _
                              (invoke "make" "hwdata.pc")))
                 (replace 'install
                          (lambda _
                            (install-file "iab.txt" (string-append #$output "/share/hwdata"))
                            (install-file "oui.txt" (string-append #$output "/share/hwdata"))
                            (install-file "pci.ids" (string-append #$output "/share/hwdata"))
                            (install-file "pnp.ids" (string-append #$output "/share/hwdata"))
                            (install-file "usb.ids" (string-append #$output "/share/hwdata"))
                            (install-file "hwdata.pc" (string-append #$output "/share/pkgconfig"))))))))))

;; TODO: Wait for this to be packaged in Guix (no patch found)
(define-public tomlplusplus
  (package
   (name "tomlplusplus")
   (version "3.4.0")
   (synopsis "C++ implementation of TOML")
   (description "Toml++ is a C++17 parser for TOML")
   (home-page "https://marzer.github.io/tomlplusplus/")
   (license expat) ; Could be X11
   (source (origin
            (method git-fetch)
            (uri (git-reference
                  (url "https://github.com/marzer/tomlplusplus")
                  (commit (string-append "v" version))
                  (recursive? #t)))
            (sha256 (base64 "h5tbO0Rv2tZezY58yUbyRVpsfRjY3i+5TPkkxr6La8M="))))
   (build-system cmake-build-system)
   (arguments '(#:tests? #f))))

;; Upstreaming blocked, see first comment
(define-public hyprland
  (package
   (name "hyprland")
   (version "0.35.0")
   (synopsis "The Hyprland tiling Wayland compositor")
   (description "Hyprland is a tiling wayland compositor written in C++ with a large dose of eye candy")
   (home-page "https://hyprland.org")
   (license bsd-3)
   (source (origin
            (method git-fetch)
            (uri (git-reference
                  (url "https://github.com/hyprwm/Hyprland")
                  (commit (string-append "v" version))
                  (recursive? #t)))
            (sha256 (base64 "6RPvAaxC255mpqPPdxTzwJDqfI2c9FaObxxx3YZ69xE="))))
   (build-system meson-build-system)
   (native-inputs (list cmake gcc-toolchain-13 hwdata jq pkg-config python))
   (inputs (list
            cairo-1.18
            hwdata-pkg-config
            libdisplay-info
            libdrm-2.4.120
            libinput-1.25
            libseat
            libxkbcommon
            mesa
            pango
            pixman
            tomlplusplus
            wayland
            wayland-protocols))))

;; Upstream after hyprland
(define-public hyprlang
  (package
   (name "hyprlang")
   (version "0.4.0")
   (synopsis "Configuration language for Hyprland")
   (description "The hypr configuration language is an extremely efficient, yet easy to work with, configuration language for GNU/linux applications.")
   (home-page "https://hyprland.org/hyprlang")
   (license gpl3+)
   (source (origin
            (method git-fetch)
            (uri (git-reference
                  (url "https://github.com/hyprwm/hyprlang")
                  (commit (string-append "v" version))))
            (sha256 (base64 "nW3Zrhh9RJcMTvOcXAaKADnJM/g6tDf3121lJtTHnYo="))))
   (build-system cmake-build-system)
   (native-inputs (list gcc-toolchain-13))))

;; Upstream after hyprland
(define-public xdg-desktop-portal-hyprland
  (package
   (name "xdg-desktop-portal-hyprland")
   (version "1.3.1")
   (synopsis "XDG-desktop-portal implementation for Hyprland")
   (description "Enhanced version of xdg-desktop-portal-wlr for Hyprland")
   (home-page "https://hyprland.org")
   (license bsd-3)
   (source (origin
            (method git-fetch)
            (uri (git-reference
                  (url "https://github.com/hyprwm/xdg-desktop-portal-hyprland")
                  (commit (string-append "v" version))
                  (recursive? #t)))
            (sha256 (base64 "SoY+5RtcC4RXlYT2lDdoiOxXLBQVYvKsdwyoCGrCNkM="))))
   (build-system meson-build-system)
   (native-inputs (list pkg-config gcc-toolchain-13))
   (inputs (list
            hyprland
            hyprlang
            libdrm-2.4.120
            mesa
            pipewire
            qtbase
            sdbus-c++
            wayland
            wayland-protocols))))

M patchwork/user.scm => patchwork/user.scm +4 -1
@@ 1,8 1,10 @@
;;; User configurations for Patchwork OS
(define-module (patchwork user)
  #:use-module (patchwork user audio)
  #:use-module (patchwork user desktop)
  #:use-module (patchwork user shells)
  #:use-module (patchwork user markers)
  #:use-module (patchwork user xdg-desktop-portal)
  #:use-module (gnu services)
  #:use-module (gnu home services desktop)
  #:use-module (guix records)


@@ 24,7 26,8 @@
        (service home-zsh-service-type patchwork-home-zsh-configuration)

        ;; TODO: patchwork-dbus-configuration, likely stored with the window manager configs
        (service home-dbus-service-type)))
        (service home-dbus-service-type)
        (service patchwork-home-xdg-desktop-portal-service-type)))

;;;The set of user services needed to set up the default Hyprland desktop
(define %patchwork-user-services-hyprland

A patchwork/user/desktop.scm => patchwork/user/desktop.scm +151 -0
@@ 0,0 1,151 @@
;;; Desktop services for PatchworkOS
(define-module (patchwork user desktop)
  #:use-module (gnu packages terminals)
  #:use-module (gnu services configuration)
  #:use-module (guix gexp)
  #:use-module (guix packages)
  #:use-module (patchwork packages desktop)
  #:use-module (patchwork user theme)
  #:export (patchwork-home-hyprland-configuration
            patchwork-home-hyprland-service-type))

;; HYPRLAND
;; TODO: finish and tweak theme
(define-maybe patchwork-theme)
(define (serialize-patchwork-hyprland-theme field theme)
  (mixed-text-file "patchwork-hyprland-theme" "\
### PATCHWORKOS THEME
general {
  col.inactive_border=rgb("(patchwork-theme-foreground theme 'comment)")
  col.active_border=rgb("(patchwork-theme-foreground theme)")
  col.nogroup_border=rgb("(patchwork-theme-accent theme 'class)")
  col.nogroup_border_active=rgb("(patchwork-theme-accent theme 'constant)")
}

decoration {
  col.shadow=rgb("(patchwork-theme-background theme)")
}

group {
  # TODO

  groupbar {
    #TODO
  }
}
"))

(define (serialize-patchwork-hyprland-default-configuration field enabled)
  (if (not enabled) "" "\
### PATCHWORK OS CONFIG
# Theming
general {
  border_size=1
  gaps_in=5
  gaps_out=10
  layout=master
  resize_on_border=true
}

decoration {
  rounding=3
  inactive_opacity=0.75
}

input {
  numlock_by_default=true
}

misc {
  enable_swallow=true
  swallow_regex=^(kitty|alacritty|foot|wezterm)$
  focus_on_activate=true
}

# Layouts
dwindle {
  pseudotile = true
  preserve_split = true
}

master {
  new_is_master = true
}

# Keybinds
$Mod = Super
$ModShift = Super
"))

(define (serialize-patchwork-hyprland-default-keybinds field enabled)
  (if (not enabled) "" (string-append "\
### PATCHWORK OS KEYBINDS
## Window control
bind=$Mod SHIFT, C, killactive
bind=$Mod SHIFT, F, togglefloating
bind=$Mod SHIFT, P, pseudo # dwindle

## Window manager control
bind=$Mod SHIFT, Esc, exit

## Layout
bind=$Mod, left, movefocus, l
bind=$Mod, H, movefocus, l

bind=$Mod, right, movefocus, r
bind=$Mod, L, movefocus, r

bind=$Mod, up, movefocus, u
bind=$Mod, K, movefocus, u

bind=$Mod, down, movefocus, d
bind=$Mod, J, movefocus, d

## Workspaces
"(map (lambda (i) (string-append "\
bind=$Mod, "(number->string i)", workspace, "(number->string i)"
bind=$Mod SHIFT, "(number->string i)", movetoworkspace, "(number->string i)"
")) (iota 9 1))"

bind=$Mod, mouse_down, workspace, e+1
bind=$Mod, mouse_up, workspace, e-1

# Special workspaces
bind=$Mod, S, togglespecialworkspace, scratch
bind=$Mod SHIFT, S, movetoworkspace, special:scratch

## Launchers
bind=$Mod, Return, exec, $terminal
")))

;; The suffix used by Patchwork, needed for the system to function
(define %patchwork-hyprland-config-suffix "\
### PATCHWORK OS SUFFIX
# Have applications default to Wayland native
env=QT_QPA_PLATFORM, wayland
env=GDK_BACKEND, wayland

# Start desktop services
exec-once=herd start desktop
")

(define-configuration patchwork-home-hyprland-configuration
  (package (package hyprland)
           "The hyprland package to use")
  (terminal (file-like (file-append foot "/bin/foot"))
            "The terminal to launch (can be overridden by user configuration")
  (theme maybe-patchwork-theme
         "The theme to use for Hyprland"
         serialize-patchwork-hyprland-theme)
  (use-patchwork-config (boolean #t)
                        "Use Patchwork's default styling and configuration"
                        serialize-patchwork-hyprland-default-configuration)
  (config (text-config '())
          "Your custom settings for Hyprland")
  (use-patchwork-keybinds (boolean #t)
                          "Use Patchwork's keybinds, if disabled only your keybinds will be loaded. Set $Mod for the modifier key"
                          serialize-patchwork-hyprland-default-keybinds))



;; TODO: LabWC

A patchwork/user/theme.scm => patchwork/user/theme.scm +81 -0
@@ 0,0 1,81 @@
;;; Theming API for PatchworkOS
(define-module (patchwork user theme)
  #:use-module (guix records)
  #:export (patchwork-theme
            make-patchwork-theme
            patchwork-theme?

            patchwork-theme-font
            patchwork-theme-base00
            patchwork-theme-base01
            patchwork-theme-base02
            patchwork-theme-base03
            patchwork-theme-base04
            patchwork-theme-base05
            patchwork-theme-base06
            patchwork-theme-base07
            patchwork-theme-base08
            patchwork-theme-base09
            patchwork-theme-base0A
            patchwork-theme-base0B
            patchwork-theme-base0C
            patchwork-theme-base0D
            patchwork-theme-base0E
            patchwork-theme-base0F

            patchwork-theme-background
            patchwork-theme-foreground
            patchwork-theme-accent))

;;; A theme, used by the Patchwork system to generate themes for all supported applications
;;; TODO: generate GTK/QT themes
(define-record-type* <patchwork-theme> patchwork-theme
  make-patchwork-theme
  patchwork-theme?
  (font patchwork-theme-font
        (default #f))
  (base00 patchwork-theme-base00)
  (base01 patchwork-theme-base01)
  (base02 patchwork-theme-base02)
  (base03 patchwork-theme-base03)
  (base04 patchwork-theme-base04)
  (base05 patchwork-theme-base05)
  (base06 patchwork-theme-base06)
  (base07 patchwork-theme-base07)
  (base08 patchwork-theme-base08)
  (base09 patchwork-theme-base09)
  (base0A patchwork-theme-base0A)
  (base0B patchwork-theme-base0B)
  (base0C patchwork-theme-base0C)
  (base0D patchwork-theme-base0D)
  (base0E patchwork-theme-base0E)
  (base0F patchwork-theme-base0F))

(define* (patchwork-theme-background theme #:optional (modifier 'default))
  (case modifier
    ((default) (patchwork-theme-base00 theme))
    ((lighter) (patchwork-theme-base01 theme))
    ((light) (patchwork-theme-base07 theme))
    ((selection) (patchwork-theme-base02 theme))
    (else (error (string-append "Invalid background modifier: " (symbol->string modifier))))))

(define* (patchwork-theme-foreground theme #:optional (modifier 'default))
  (case modifier
    ((default) (patchwork-theme-base05 theme))
    ((comment) (patchwork-theme-base03 theme))
    ((dark) (patchwork-theme-base04 theme))
    ((light) (patchwork-theme-base06 theme))
    (else (error (string-append "Invalid foreground modifier: " (symbol->string modifier))))))


(define (patchwork-theme-accent theme type)
  (case type
    ((variable) (patchwork-theme-base08 theme))
    ((constant) (patchwork-theme-base09 theme))
    ((class) (patchwork-theme-base0A theme))
    ((string) (patchwork-theme-base0B theme))
    ((escape) (patchwork-theme-base0C theme))
    ((function) (patchwork-theme-base0D theme))
    ((keyword) (patchwork-theme-base0E theme))
    ((deprecated) (patchwork-theme-base0F theme))
    (else (error (string-append "Invalid accent type: " (symbol->string type))))))

A patchwork/user/xdg-desktop-portal.scm => patchwork/user/xdg-desktop-portal.scm +52 -0
@@ 0,0 1,52 @@
;;; Configuration for XDG desktop portals in Patchwork OS
;;; NOTE: this could possibly use multiple shepherd services providing markers for their respective features, but this works for now
(define-module (patchwork user xdg-desktop-portal)
  #:use-module (gnu home services)
  #:use-module (gnu home services shepherd)
  #:use-module (gnu packages freedesktop)
  #:use-module (gnu services configuration)
  #:use-module (guix gexp)
  #:use-module (guix packages)
  #:use-module (patchwork packages desktop)
  #:export (%default-xdg-desktop-portals
            patchwork-home-xdg-desktop-portal-configuration
            patchwork-home-xdg-desktop-portal-service-type))

(define %default-xdg-desktop-portals
  #~(do (spawn #$(file-append xdg-desktop-portal-hyprland "/libexec/xdg-desktop-portal-hyprland") '("xdg-desktop-portal-hyprland"))
        (spawn #$(file-append xdg-desktop-portal-gtk "/libexec/xdg-desktop-portal-gtk")) '("xdg-desktop-portal-gtk")))

(define-configuration/no-serialization patchwork-home-xdg-desktop-portal-configuration
  (package (package xdg-desktop-portal)
           "The base xdg-desktop-portal package to use")
  (portals (gexp %default-xdg-desktop-portals)
           "A G-Expression that spawns all needed XDG Desktop Portals"))

(define (xdg-desktop-portal-process cfg)
  "Spawns the XDG desktop portals and their supervisor"
  (program-file "patchwork-xdg-desktop-portal-process"
   #~(do
       #$(patchwork-home-xdg-desktop-portal-configuration-portals cfg)
       (sleep 5)
       (system* #$(file-append (patchwork-home-xdg-desktop-portal-configuration-package cfg) "/libexec/xdg-desktop-portal")))))


(define (xdg-desktop-portal-shepherd-sv cfg)
  (shepherd-service
   (documentation "Service used to spawn in the XDG desktop portals")
   (provision '(xdg-desktop-portal))
   (requirement '(desktop dbus))
   (start #~(make-forkexec-constructor
             (list #$(xdg-desktop-portal-process cfg))))
   (stop #~(make-kill-destructor))))

(define (xdg-desktop-portal-shepherd-svs cfg)
 (list (xdg-desktop-portal-shepherd-sv cfg)))

(define patchwork-home-xdg-desktop-portal-service-type
  (service-type
   (name 'xdg-desktop-portal)
   (extensions (list (service-extension home-shepherd-service-type
                                        xdg-desktop-portal-shepherd-svs)))
   (description "Start the XDG Desktop Portals")
   (default-value (patchwork-home-xdg-desktop-portal-configuration))))