From patchwork Mon Oct 17 16:47:03 2022 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: "\\(" X-Patchwork-Id: 43467 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 8C41527BBEA; Mon, 17 Oct 2022 17:53:33 +0100 (BST) X-Spam-Checker-Version: SpamAssassin 3.4.6 (2021-04-09) on mira.cbaines.net X-Spam-Level: X-Spam-Status: No, score=-3.7 required=5.0 tests=BAYES_00,DKIM_INVALID, DKIM_SIGNED,MAILING_LIST_MULTI,RCVD_IN_MSPIKE_H2,SPF_HELO_PASS, URIBL_BLOCKED autolearn=unavailable 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 842B327BBE9 for ; Mon, 17 Oct 2022 17:53:32 +0100 (BST) Received: from localhost ([::1]:60320 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1okTMp-0001m6-0e for patchwork@mira.cbaines.net; Mon, 17 Oct 2022 12:53:31 -0400 Received: from eggs.gnu.org ([2001:470:142:3::10]:53776) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1okTMM-0001jE-OY for guix-patches@gnu.org; Mon, 17 Oct 2022 12:53:02 -0400 Received: from debbugs.gnu.org ([209.51.188.43]:50714) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1okTMM-0003kd-Fx for guix-patches@gnu.org; Mon, 17 Oct 2022 12:53:02 -0400 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1okTMM-00067n-CT for guix-patches@gnu.org; Mon, 17 Oct 2022 12:53:02 -0400 X-Loop: help-debbugs@gnu.org Subject: [bug#58585] [PATCH 2/2] gnu: home: Add home-mako-service-type. Resent-From: "(" Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Mon, 17 Oct 2022 16:53:02 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 58585 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch To: 58585@debbugs.gnu.org Cc: "\(" Received: via spool by 58585-submit@debbugs.gnu.org id=B58585.166602552923472 (code B ref 58585); Mon, 17 Oct 2022 16:53:02 +0000 Received: (at 58585) by debbugs.gnu.org; 17 Oct 2022 16:52:09 +0000 Received: from localhost ([127.0.0.1]:49787 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1okTLH-00065s-Ld for submit@debbugs.gnu.org; Mon, 17 Oct 2022 12:52:09 -0400 Received: from knopi.disroot.org ([178.21.23.139]:52806) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1okTLD-00065Y-Bz for 58585@debbugs.gnu.org; Mon, 17 Oct 2022 12:51:52 -0400 Received: from localhost (localhost [127.0.0.1]) by disroot.org (Postfix) with ESMTP id BFA4B4DAF5; Mon, 17 Oct 2022 18:51:50 +0200 (CEST) X-Virus-Scanned: SPAM Filter at disroot.org Received: from knopi.disroot.org ([127.0.0.1]) by localhost (disroot.org [127.0.0.1]) (amavisd-new, port 10024) with UTF8SMTP id MNTjBjz0AhBl; Mon, 17 Oct 2022 18:51:49 +0200 (CEST) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/simple; d=disroot.org; s=mail; t=1666025228; bh=T+VTlJyztDSbdljieBgc+AZErc0RFT7GoIJ79AEcs0o=; h=From:To:Cc:Subject:Date:In-Reply-To:References; b=jg/8kzDJ8NsR995/qFVAFA95toPMBhHQVbeiVgF3IZq15lKV+N9TK8JP8iIA3T7HI r4i8brDVO7eU+jm9uPQOH65W3wSY+Qb1pXttLAonApEtH6+cIndUUcRWYy5a8+g0Kz /vw+fHiDOLiFpqgJ0GXoS4D/YBr0XskU2ly0pS+i1P9I8ITMnyCpfTVr/CsADu/Or/ n0ppH4WKhI53Pewvcg2n4thfK0ffT5mBu5LMS26CCCXnGwpiCwuBKpNb9rdJ+mDOQl yTe2BlP49gZMGVlfrawfSSIUgrskbP/WUqmQCtT6kKSKhXWnzpJ4T1INOVvh3F4SxK 16kYfqFaVuKSg== Date: Mon, 17 Oct 2022 17:47:03 +0100 Message-Id: <20221017164703.14949-2-paren@disroot.org> In-Reply-To: <20221017164703.14949-1-paren@disroot.org> References: <20221017164703.14949-1-paren@disroot.org> Mime-Version: 1.0 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" Reply-to: "\(" X-ACL-Warn: , "\( via Guix-patches" X-Patchwork-Original-From: "\( via Guix-patches" via From: "\\(" X-getmail-retrieved-from-mailbox: Patches * gnu/home/services/desktop.scm (home-mako-section, home-mako-configuration): New record types. (%home-mako-default-section, %home-mako-default-grouped-section, home-mako-service-type): New variables. Unfortunately, there is no way to actually use this service to run the daemon itself, as Mako tries to connect to Wayland, which is impossible as WAYLAND_DISPLAY is almost never set in session Shepherd's environment. So, this service simply writes the configuration file to $XDG_CONFIG_HOME/mako/config, and leave the actual execution of ``mako'' to the user. --- gnu/home/services/desktop.scm | 338 +++++++++++++++++++++++++++++++++- 1 file changed, 336 insertions(+), 2 deletions(-) diff --git a/gnu/home/services/desktop.scm b/gnu/home/services/desktop.scm index a2ab2b4d07..a929a7533a 100644 --- a/gnu/home/services/desktop.scm +++ b/gnu/home/services/desktop.scm @@ -22,17 +22,26 @@ (define-module (gnu home services desktop) #:use-module (gnu home services shepherd) #:use-module (gnu services configuration) #:autoload (gnu packages glib) (dbus) + #:autoload (gnu packages wm) (mako) #:autoload (gnu packages xdisorg) (redshift) - #:use-module (guix records) #:use-module (guix gexp) + #:use-module (guix records) #:use-module (srfi srfi-1) + #:use-module (srfi srfi-26) + #:use-module (ice-9 format) #:use-module (ice-9 match) #:export (home-redshift-configuration home-redshift-configuration? home-redshift-service-type home-dbus-configuration - home-dbus-service-type)) + home-dbus-service-type + + home-mako-section + %home-mako-default-section + %home-mako-default-grouped-section + home-mako-configuration + home-mako-service-type)) ;;; @@ -224,3 +233,328 @@ (define home-dbus-service-type (default-value (home-dbus-configuration)) (description "Run the session-specific D-Bus inter-process message bus."))) + + +;;; +;;; Mako. +;;; + +(define-record-type* + home-mako-section make-home-mako-section + home-mako-section? + + (if-app-name home-mako-if-app-name ;string | #f + (default #f)) + (if-app-icon home-mako-if-app-icon ;string | #f + (default #f)) + (if-summary home-mako-if-summary ;string | #f + (default #f)) + (if-summary-regex? home-mako-if-summary-regex? ;boolean + (default #f)) + (if-body home-mako-if-body ;string | #f + (default #f)) + (if-body-regex? home-mako-if-body-regex? ;boolean + (default #f)) + (if-urgency home-mako-if-urgency ;'low | 'normal | 'critical | #f + (default #f)) + (if-category home-mako-if-category ;string | #f + (default #f)) + (if-desktop-entry home-mako-if-desktop-entry ;string | #f + (default #f)) + (if-actionable? home-mako-if-actionable? ;boolean | '() + (default '())) + (if-expiring? home-mako-if-expiring? ;boolean | '() + (default '())) + (if-mode home-mako-if-mode ;string | #f + (default #f)) + (if-grouped? home-mako-if-grouped? ;boolean | '() + (default '())) + (if-group-index home-mako-if-group-index ;integer | #f + (default #f)) + (if-hidden? home-mako-if-hidden? ;boolean | '() + (default '())) + (if-output home-mako-if-output ;string | #f + (default #f)) + (if-anchor home-mako-if-anchor ;'top-right | 'top-center | 'top-left | 'bottom-right | 'bottom-center | 'bottom-left | 'center-right | 'center-left | 'center | #f + (default #f)) + + (on-button-left home-mako-on-button-left ;#f | 'default | 'dismiss | 'dismiss-all | 'dismiss-group | list of (file-like | string) + (default 'default)) + (on-button-middle home-mako-on-button-middle ;#f | 'default | 'dismiss | 'dismiss-all | 'dismiss-group | string | list of (file-like | string) + (default #f)) + (on-button-right home-mako-on-button-right ;#f | 'default | 'dismiss | 'dismiss-all | 'dismiss-group | list of (file-like | string) + (default 'dismiss)) + (on-touch home-mako-on-touch ;#f | 'default | 'dismiss | 'dismiss-all | 'dismiss-group | list of (file-like | string) + (default 'dismiss)) + (on-notify home-mako-on-notify ;#f | 'default | 'dismiss | 'dismiss-all | 'dismiss-group | list of (file-like | string) + (default #f)) + + (font home-mako-font ;string + (default "monospace")) + (font-size home-mako-font-size ;number + (default 10)) + + (background-color home-mako-background-color ;string + (default "285577FF")) + (text-color home-mako-text-color ;string + (default "FFFFFFFF")) + + (width home-mako-width ;integer + (default 300)) + (height home-mako-height ;integer + (default 100)) + (outer-margin home-mako-outer-margin ;list of integer + (default '(0))) + (margin home-mako-margin ;list of integer + (default '(10))) + (padding home-mako-padding ;list of integer + (default '(5))) + + (border-size home-mako-border-size ;integer + (default 2)) + (border-color home-mako-border-color ;string + (default "4C7899FF")) + (border-radius home-mako-border-radius ;integer + (default 0)) + + (progress-color home-mako-progress-color ;string + (default "5588AAFF")) + (progress-style home-mako-progress-style ;'over | 'source + (default 'over)) + + (icons? home-mako-icons? ;boolean + (default #t)) + (max-icon-size home-mako-max-icon-size ;integer + (default 64)) + (icon-path home-mako-icon-path ;list of string + (default '())) + (icon-location home-mako-icon-location ;'left | 'right | 'top | 'bottom + (default 'left)) + + (markup? home-mako-markup? ;boolean + (default #t)) + (actions? home-mako-actions? ;boolean + (default #t)) + (history? home-mako-history? ;boolean + (default #t)) + (invisible? home-mako-invisible? ;boolean + (default #f)) + + (format home-mako-format + (default "%s\\n%b")) + (text-alignment home-mako-text-alignment ;'left | 'center | 'right + (default 'left)) + + (default-timeout home-mako-default-timeout ;integer + (default 0)) + (ignore-timeout? home-mako-ignore-timeout? ;boolean + (default #f)) + + (group-by home-mako-group-by ;list of string + (default #f)) + (max-visible home-mako-max-visible ;integer + (default #f)) + + (output home-mako-output ;string + (default #f)) + (layer home-mako-layer ;'background | 'bottom | 'top | 'overlay + (default 'top)) + (anchor home-mako-anchor ;'top-right | 'top-center | 'top-left | 'bottom-right | 'bottom-center | 'bottom-left | 'center-right | 'center-left | 'center + (default #f))) + +(define (home-mako-configuration-header-attributes section) + (define (boolean-clause name field) + (let ((value (field section))) + (cond ((null? value) '()) + (value (list "!" name " ")) + (else (list name))))) + + (define (string-clause name field) + (let ((value (field section))) + (if value + (list name "=\"" value "\" ") + '()))) + + (define (symbol-clause name field) + (if (field section) + (string-clause name (compose symbol->string field)) + '())) + + (define (number-clause name field) + (if (field section) + (string-clause name (compose number->string field)) + '())) + + (append (string-clause "app-name" home-mako-if-app-name) + (string-clause "app-icon" home-mako-if-app-icon) + (string-clause (if (home-mako-if-summary-regex? section) + "summary~" + "summary") + home-mako-if-summary) + (string-clause (if (home-mako-if-body-regex? section) + "body~" + "body") + home-mako-if-body) + (symbol-clause "urgency" home-mako-if-urgency) + (string-clause "category" home-mako-if-category) + (string-clause "desktop-entry" home-mako-if-desktop-entry) + (boolean-clause "actionable" home-mako-if-actionable?) + (boolean-clause "expiring" home-mako-if-expiring?) + (string-clause "mode" home-mako-if-mode) + (boolean-clause "grouped" home-mako-if-grouped?) + (number-clause "group-index" home-mako-if-group-index) + (boolean-clause "hidden" home-mako-if-hidden?) + (string-clause "output" home-mako-if-output) + (symbol-clause "anchor" home-mako-if-anchor))) + +(define (home-mako-configuration-header section) + (match (home-mako-configuration-header-attributes section) + (() '()) + ((attributes ...) + (append (list "\n[ ") attributes (list "]\n"))))) + +(define (home-mako-configuration-body section) + (define (string-clause name field) + (let ((value (field section))) + (if value + (list name "=" (field section) "\n") + '()))) + + (define (boolean-clause name field) + (list name "=" (if (field section) "1" "0") "\n")) + + (define (number-clause name field) + (if (field section) + (string-clause name (compose number->string field)) + '())) + + (define (symbol-clause name field) + (if (field section) + (string-clause name (compose symbol->string field)) + '())) + + (define (colour-clause name field) + (string-clause name (compose (cute string-append "#" <>) + field))) + + (define (directional-clause name field) + (if (field section) + (string-clause name (compose (cute string-join <> ",") + (cute map number->string <>) + field)) + '())) + + (define (event-clause name field) + (append (list name "=") + (match (field section) + ('default (list "invoke-default-action")) + ('dismiss (list "dismiss")) + ('dismiss-all (list "dismiss-all")) + ('dismiss-group (list "dismiss-group")) + ((args ...) + (append (list "exec") + (append-map (cute list " \"" <> "\"") + args))) + (#f (list "none"))) + (list "\n"))) + + (append (event-clause "on-button-left" home-mako-on-button-left) + (event-clause "on-button-middle" home-mako-on-button-middle) + (event-clause "on-button-right" home-mako-on-button-right) + (event-clause "on-touch" home-mako-on-touch) + (event-clause "on-notify" home-mako-on-notify) + (list "font=" (home-mako-font section) " " + (number->string (home-mako-font-size section)) "\n") + (colour-clause "background-color" home-mako-background-color) + (colour-clause "text-color" home-mako-text-color) + (number-clause "width" home-mako-width) + (number-clause "height" home-mako-height) + (directional-clause "outer-margin" home-mako-outer-margin) + (directional-clause "margin" home-mako-margin) + (directional-clause "padding" home-mako-padding) + (number-clause "border-size" home-mako-border-size) + (colour-clause "border-color" home-mako-border-color) + (number-clause "border-radius" home-mako-border-radius) + (list "progress-color=" + (symbol->string (home-mako-progress-style section)) + " #" (home-mako-progress-color section) "\n") + (boolean-clause "icons" home-mako-icons?) + (number-clause "max-icon-size" home-mako-max-icon-size) + (string-clause "icon-path" + (compose (cute string-join <> ":") + home-mako-icon-path)) + (symbol-clause "icon-location" home-mako-icon-location) + (boolean-clause "markup" home-mako-markup?) + (boolean-clause "actions" home-mako-actions?) + (boolean-clause "history" home-mako-history?) + (boolean-clause "invisible" home-mako-invisible?) + (string-clause "format" home-mako-format) + (symbol-clause "text-alignment" home-mako-text-alignment) + (number-clause "default-timeout" home-mako-default-timeout) + (boolean-clause "ignore-timeout" home-mako-ignore-timeout?) + (boolean-clause "ignore-timeout" home-mako-ignore-timeout?) + (if (home-mako-group-by section) + (string-clause "group-by" + (compose (cute string-join <> ",") + home-mako-group-by)) + '()) + (number-clause "max-visible" home-mako-max-visible) + (string-clause "output" home-mako-output) + (symbol-clause "layer" home-mako-layer) + (symbol-clause "anchor" home-mako-anchor))) + +(define (home-mako-configuration-section section) + (append (home-mako-configuration-header section) + (home-mako-configuration-body section))) + +(define %home-mako-default-section (home-mako-section)) + +(define %home-mako-default-grouped-section + (home-mako-section + (if-grouped? #t) + (format "(%g) %s\\n%b"))) + +(define-record-type* + home-mako-configuration make-home-mako-configuration + home-mako-configuration? + + (mako home-mako-configuration-mako ;file-like + (default mako)) + (sections home-mako-configuration-sections ;list of + (default (list %home-mako-default-section + %home-mako-default-grouped-section))) + + (max-history home-mako-configuration-max-history ;integer + (default 5)) + (sort home-mako-configuration-sort ;'time | 'priority + (default 'time)) + (sort-order home-mako-configuration-sort-order ;'ascending | 'descending + (default 'descending))) + +(define (home-mako-configuration-file config) + (apply mixed-text-file "mako-config" + (append (list "max-history=" + (number->string + (home-mako-configuration-max-history config)) + "\n" + "sort=" + (match (home-mako-configuration-sort-order config) + ('ascending "+") + ('descending "-")) + (symbol->string (home-mako-configuration-sort config)) + "\n") + (append-map home-mako-configuration-section + (home-mako-configuration-sections config))))) + +(define (home-mako-xdg-configuration-files config) + `(("mako/config" ,(home-mako-configuration-file config)))) + +(define home-mako-service-type + (service-type + (name 'home-mako) + (extensions + (list (service-extension home-xdg-configuration-files-service-type + home-mako-xdg-configuration-files))) + (default-value (home-mako-configuration)) + (description + "Install and configure the @code{mako} notification daemon.")))