diff options
Diffstat (limited to 'sigils/home/services/wayland.scm')
| -rw-r--r-- | sigils/home/services/wayland.scm | 155 |
1 files changed, 47 insertions, 108 deletions
diff --git a/sigils/home/services/wayland.scm b/sigils/home/services/wayland.scm index 070c0c7..6c2dc9d 100644 --- a/sigils/home/services/wayland.scm +++ b/sigils/home/services/wayland.scm @@ -1,25 +1,3 @@ -;;; si sourcehut avait une ipv6 je pourrais leur envoyer des mails -;;; mais je peux pas donc rde aura pas mes changements -;;; -;;; rde --- Reproducible development environment. -;;; -;;; Copyright © 2022 Andrew Tropin <andrew@trop.in> -;;; -;;; This file is part of rde. -;;; -;;; rde 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. -;;; -;;; rde 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 rde. If not, see <http://www.gnu.org/licenses/>. - (define-module (sigils home services wayland) #:use-module (gnu home services) #:use-module (gnu home services shepherd) @@ -37,105 +15,66 @@ #:use-module (ice-9 match) #:export (home-kanshi-service-type - home-kanshi-configuration - sway-config?)) - - -(define sway-config? list?) -(define (serialize-sway-config val) - (define (aligner nestness) - (apply string-append - (map (const " ") (iota nestness)))) - - (define (serialize-sway-term term) - ;; (format #t "finval. ~a\n" term) - (match term - (#t "yes") - (#f "no") - ((? symbol? e) (symbol->string e)) - ((? number? e) (number->string e)) - ;; TODO: Change it to ((? string? e) (format #f "~s" e)) - ((? string? e) e) - ((lst ...) - (raise (formatted-message - (G_ "Sway term should be a non-list value (string, \ -boolean, number, symbol, or gexp). Provided term is:\n ~a") lst))) - (e e))) - - (define* (serialize-sway-expression - expr #:optional (nestness 0)) - ;; (format #t "expres. ~a\n" expr) - (match expr - ;; subconfig has the same structure as config, - ;; the only difference: it's not a top-level form - ;; can be found at the end of expression. - ;; (term subconfig) - ((term ((expressions ...) ...)) - ;; (format #t "subtop. ~a . ~a\n" term expressions) - (append - (list (serialize-sway-term term) " {\n") - (serialize-sway-subconfig expressions (1+ nestness)) - `(,(aligner nestness) - "}\n"))) - - ;; subexpression: - ;; (term . rest) - ((term rest ..1) - ;; (format #t "inside. ~a . ~a\n" term rest) - (cons* (serialize-sway-term term) " " - (serialize-sway-expression rest))) - - ;; last element of subexpression - ((term) - ;; (format #t "term. ~a\n" term) - (list (serialize-sway-term term) "\n")) - - (e - (raise (formatted-message - (G_ "Sway expression should be a list of terms \ -optionally ending with subconfigs, but provided expression is:\n ~a") - e))))) - - (define* (serialize-sway-subconfig - subconfig #:optional (nestness 0)) - (match subconfig - ;; config: - ;; ((expr1) (expr2) (expr3)) - (((expressions ...) ...) - (append-map - (lambda (e) - (append (list (aligner nestness)) - (serialize-sway-expression e nestness))) - expressions)) - (e - (raise (formatted-message - (G_ "Sway (sub)config should be a list of expressions, \ -where each expression is also a list, but provided value is:\n ~a") e))) )) - - (serialize-sway-subconfig val)) + home-kanshi-configuration)) ;;; ;;; kanshi. ;;; -(define (serialize-string field-name value) value) +(define kanshi-config? list?) + +(define (serialize-kanshi-config config) + (define serialize-term + (match-lambda + ((? symbol? e) `(" " ,(symbol->string e))) + ((? number? e) `(" " ,(number->string e))) + ((? string? e) `(" " ,(format #f "~s" e))) + (e `(" " ,e)))) + + (define serialize-statement + (match-lambda + ((cmd . lst) + `(,(symbol->string cmd) + ,@(append-map serialize-term lst))))) + + (define serialize-profile + (match-lambda + ((name ((expressions ...) ...)) + `("profile " ,(symbol->string name) " {\n" + ,@(append-map + (lambda (expr) `(" " ,@(serialize-statement expr) "\n")) + expressions) + "}\n")))) + + (append-map serialize-profile config)) (define-configuration home-kanshi-configuration (kanshi (file-like kanshi) "kanshi package to use.") (config - (sway-config + (kanshi-config `()) - "This field has the same format as sway's config field, but in reality kanshi -supports only a subset of sway config. To get the complete list of available -options see @code{man 5 kanshi}. + "The kanshi configuration is a list of profiles with output and exec fields. +@lisp +'((static ((output LVDS-1 disable) + (output \"Some Company ASDF 4242\" mode 1600x900 position 0,0))) + (portable ((output LVDS-1 enable scale 2)))) +@end lisp -The example configuration: +serializes to -@lisp -() -@end lisp")) +@code +profile static { + output LVDS-1 disable + output \"Some Company ASDF 4242\" mode 1600x900 position 0,0 +} + +profile portable { + output LVDS-1 enable scale 2 +} +@end code +")) (define (add-kanshi-packages config) (list (home-kanshi-configuration-kanshi config))) @@ -145,7 +84,7 @@ The example configuration: ,(apply mixed-text-file "kanshi-config" - (serialize-sway-config (home-kanshi-configuration-config config)))))) + (serialize-kanshi-config (home-kanshi-configuration-config config)))))) (define (home-kanshi-shepherd-service config) (let ((kanshi (home-kanshi-configuration-kanshi config))) |