From debbugs-submit-bounces@debbugs.gnu.org Tue Sep 27 05:55:55 2022 Received: (at 57963) by debbugs.gnu.org; 27 Sep 2022 09:55:56 +0000 Received: from localhost ([127.0.0.1]:52894 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1od7Jj-0004tB-EY for submit@debbugs.gnu.org; Tue, 27 Sep 2022 05:55:55 -0400 Received: from mail-pg1-f181.google.com ([209.85.215.181]:45862) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1od7Je-0004st-0z for 57963@debbugs.gnu.org; Tue, 27 Sep 2022 05:55:53 -0400 Received: by mail-pg1-f181.google.com with SMTP id r62so5109880pgr.12 for <57963@debbugs.gnu.org>; Tue, 27 Sep 2022 02:55:49 -0700 (PDT) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=taiju-info.20210112.gappssmtp.com; s=20210112; h=content-transfer-encoding:mime-version:message-id:date:subject:cc :to:from:from:to:cc:subject:date; bh=cdWhS+Qz1yPjvOsmI4PrFoJjJb50CRiXBRa7uh833xM=; b=cboOiLfKV/b9ZiLbf/H9Wc8hnSYsb8so3anDivj5atFL4nK5nzbYHInS32ZMcSb5cZ Y2cowMVqikC/pEM4pX0qU/lyvN/XpHEpDk6z9tyJEdVBNoA9BflpnioB2zMuHaXUCweX ehzXq1MGokG5UpTGLtUSdj3ACkUpHdXy4nKrPR8/XBb/mmDtx0l3ay83tftUuhTTxWPs 9wKijQMGGIucpc0kK9ooy9FI819y2EsIk5V7owsfkOPcIF+H3KRgRgXp3YVohrQ0T/2a dPDjUjX6YW1BRzMACmQKahU58dmws6bS+WfJPfEPg1pAcZipY0/w20I8xtJXvnGy90qn ZGSQ== X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20210112; h=content-transfer-encoding:mime-version:message-id:date:subject:cc :to:from:x-gm-message-state:from:to:cc:subject:date; bh=cdWhS+Qz1yPjvOsmI4PrFoJjJb50CRiXBRa7uh833xM=; b=OoyjPciM+rcrcTKYmikzoefZ8SVy4lEsgf9CP9Q8Is0rlC0MFEQboe/Li2Twvkiu7Y hqwWs5gV9iOtAURp1fRMMxc1fKnnnhpc+QLrHMbBTrOcoYQTQECLd+gpKzuafjPA2zAk QZ018Q0Jo4Amtok5Pyvr1psvrLxzNxnV/PQu52Zn+nY/l53uHW6owJKJw2hsglKn138i omqCrPE84n1GzIIvOdEfD586iUNbVbDnJlIeqDgRhwpQ0aIvjLWywJr+e4Oh0S0Mk2/Z uEnMg3RkmClgN7IpNC5ooe8rpOd0DX+Dw++QoAXe+v30V8AtmOrUUbh88jNXcRlN+xQF xNIQ== X-Gm-Message-State: ACrzQf2aMorCO0c3vZftSG2eRdgP+3nm/HACBsUsvjKREWRrWqHrYNzF aj8UT1C8Eifdnkq+sVxRgz1Gdg== X-Google-Smtp-Source: AMsMyM5Y4nhjHtJW75fSPJzU++Zp8vXHE6UwdsbBd/HSZNnvPzEpqCCO0yMmDf4Y6H0eDubRaw0dFA== X-Received: by 2002:a62:e20f:0:b0:556:4265:5de2 with SMTP id a15-20020a62e20f000000b0055642655de2mr23896644pfi.57.1664272544140; Tue, 27 Sep 2022 02:55:44 -0700 (PDT) Received: from Taix.flets-west.jp ([240b:253:ec40:2400:b7d1:436e:2d61:e925]) by smtp.gmail.com with ESMTPSA id u16-20020a170902e5d000b00172f6726d8esm1067770plf.277.2022.09.27.02.55.42 (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Tue, 27 Sep 2022 02:55:43 -0700 (PDT) From: Taiju HIGASHI To: ludo@gnu.org, liliana.prikler@gmail.com, andrew@trop.in Subject: [PATCH v3] home: fontutils: Support user's fontconfig. Date: Tue, 27 Sep 2022 18:55:25 +0900 Message-Id: <20220927095525.26431-1-higashi@taiju.info> X-Mailer: git-send-email 2.37.3 MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit X-Spam-Score: 2.0 (++) X-Spam-Report: Spam detection software, running on the system "debbugs.gnu.org", has NOT identified this incoming email as spam. The original message has been attached to this so you can view it or label similar future email. If you have any questions, see the administrator of that system for details. Content preview: * gnu/home/services/fontutils.scm (add-fontconfig-config-file): Support user's fontconfig. --- gnu/home/services/fontutils.scm | 103 ++++++++++++++++++++++++++++++-- 1 file changed, 97 insertions(+), [...] Content analysis details: (2.0 points, 10.0 required) pts rule name description ---- ---------------------- -------------------------------------------------- 0.0 SPF_NONE SPF: sender does not publish an SPF Record 2.0 PDS_OTHER_BAD_TLD Untrustworthy TLDs [URI: yoctocell.xyz (xyz)] 0.0 SPF_HELO_NONE SPF: HELO does not publish an SPF Record -0.0 RCVD_IN_DNSWL_NONE RBL: Sender listed at https://www.dnswl.org/, no trust [209.85.215.181 listed in list.dnswl.org] 0.0 RCVD_IN_MSPIKE_H3 RBL: Good reputation (+3) [209.85.215.181 listed in wl.mailspike.net] 0.0 RCVD_IN_MSPIKE_WL Mailspike good senders X-Debbugs-Envelope-To: 57963 Cc: 57963@debbugs.gnu.org, Taiju HIGASHI X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: 1.0 (+) * gnu/home/services/fontutils.scm (add-fontconfig-config-file): Support user's fontconfig. --- gnu/home/services/fontutils.scm | 103 ++++++++++++++++++++++++++++++-- 1 file changed, 97 insertions(+), 6 deletions(-) diff --git a/gnu/home/services/fontutils.scm b/gnu/home/services/fontutils.scm index 6062eaed6a..b02f43a4fc 100644 --- a/gnu/home/services/fontutils.scm +++ b/gnu/home/services/fontutils.scm @@ -1,6 +1,7 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2021 Andrew Tropin ;;; Copyright © 2021 Xinglu Chen +;;; Copyright © 2022 Taiju HIGASHI ;;; ;;; This file is part of GNU Guix. ;;; @@ -20,9 +21,16 @@ (define-module (gnu home services fontutils) #:use-module (gnu home services) #:use-module (gnu packages fontutils) + #:use-module (gnu services configuration) #:use-module (guix gexp) + #:use-module (guix records) + #:use-module (srfi srfi-1) + #:use-module (sxml simple) + #:use-module (ice-9 match) - #:export (home-fontconfig-service-type)) + #:export (home-fontconfig-service-type + home-fontconfig-configuration + default-font)) ;;; Commentary: ;;; @@ -33,15 +41,96 @@ (define-module (gnu home services fontutils) ;;; ;;; Code: -(define (add-fontconfig-config-file he-symlink-path) +(define-record-type* default-font + make-default-font + default-font? + (serif default-font-serif (default "")) + (sans-serif defalut-font-sans-serif (default "")) + (monospace default-font-monospace (default ""))) + +(define (sxml->xmlstring sxml) + (if (null? sxml) + "" + (call-with-output-string + (lambda (port) + (sxml->xml sxml port) + (newline port))))) + +(define font-directories? list?) + +(define (serialize-font-directories field-name value) + (sxml->xmlstring + (append + '((dir "~/.guix-home/profile/share/fonts")) + (map + (lambda (path) + `(dir ,path)) + value)))) + +(define extra-config-list? list?) + +(define (serialize-extra-config-list field-name value) + (sxml->xmlstring + (map (match-lambda + ((? pair? sxml) sxml) + ((? string? xml) (xml->sxml xml)) + (_ (error "extra-config value must be xml string or sxml list."))) + value))) + +(define (serialize-default-font field-name value) + (match value + (($ serif sans-serif monospace) + (sxml->xmlstring + (fold (lambda (pair sxml) + (if (string-null? (cdr pair)) + sxml + (append sxml + `((alias + (family ,(car pair)) + (prefer + (family ,(cdr pair)))))))) + '() + `((serif . ,serif) + (sans-serif . ,sans-serif) + (monospace . ,monospace))))))) + +(define-configuration home-fontconfig-configuration + (font-directories + (font-directories '()) + "The directory list that provides fonts.") + (preferred-default-font + (default-font (default-font)) + "The preffered default fonts for serif, sans-serif, and monospace.") + (extra-config + (extra-config-list '()) + "Extra configuration values to append to the fonts.conf.")) + +(define (home-fontconfig-extend original-config extend-configs) + (home-fontconfig-configuration + (inherit original-config) + (font-directories + (append + (home-fontconfig-configuration-font-directories original-config) + (append-map home-fontconfig-configuration-font-directories extend-configs))) + (preferred-default-font + (home-fontconfig-configuration-preferred-default-font + (if (null? extend-configs) + original-config + (last extend-configs)))) + (extra-config + (append + (home-fontconfig-configuration-extra-config original-config) + (append-map home-fontconfig-configuration-extra-config extend-configs))))) + +(define (add-fontconfig-config-file user-config) `(("fontconfig/fonts.conf" ,(mixed-text-file "fonts.conf" " - - ~/.guix-home/profile/share/fonts -")))) +\n" + (serialize-configuration user-config home-fontconfig-configuration-fields) + "\n")))) (define (regenerate-font-cache-gexp _) `(("profile/share/fonts" @@ -49,6 +138,8 @@ (define (regenerate-font-cache-gexp _) (define home-fontconfig-service-type (service-type (name 'home-fontconfig) + (compose identity) + (extend home-fontconfig-extend) (extensions (list (service-extension home-xdg-configuration-files-service-type @@ -59,7 +150,7 @@ (define home-fontconfig-service-type (service-extension home-profile-service-type (const (list fontconfig))))) - (default-value #f) + (default-value (home-fontconfig-configuration)) (description "Provides configuration file for fontconfig and make fc-* utilities aware of font packages installed in Guix Home's profile."))) -- 2.37.3