122 lines
3.9 KiB
Scheme
122 lines
3.9 KiB
Scheme
;;;
|
|
;;; This file if part of riverguile, the scheme powered scripting layer for
|
|
;;; the river Wayland desktop.
|
|
;;;
|
|
;;; Copyright (C) 2024 Leon Henrik Plickat <leonhenrik.plickat@stud.uni-goettingen.de>
|
|
;;;
|
|
;;; This library is free software; you can redistribute it and/or
|
|
;;; modify it under the terms of the GNU Lesser General Public
|
|
;;; License version 3 as published by the Free Software Foundation.
|
|
;;;
|
|
;;; This library 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
|
|
;;; Lesser General Public License for more details.
|
|
;;;
|
|
;;; You should have received a copy of the GNU Lesser General Public
|
|
;;; License along with this library; if not, write to the Free Software
|
|
;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
|
|
|
|
;; This module provides helper macros and procedures for riverguile and will not
|
|
;; be useful in any other context. The contents of this module are documented
|
|
;; in the riverguile.1 manual page.
|
|
|
|
(define-module (riverguile)
|
|
#:export (R
|
|
R:input
|
|
R:map
|
|
R:keyboard-group
|
|
handle-exit
|
|
handle-idle
|
|
handle-layout-demand
|
|
handle-user-command
|
|
handle-new-output
|
|
; Provided by C, injected into this module
|
|
riverctl
|
|
install-handler
|
|
seat
|
|
outputs
|
|
output-name
|
|
output-focused-tags
|
|
output-view-tags
|
|
output-urgent-tags
|
|
output-layout-name
|
|
seat-focused-output
|
|
seat-focused-view-title
|
|
seat-mode
|
|
))
|
|
(use-modules (srfi srfi-1))
|
|
|
|
(define (stringify x)
|
|
(cond ((string? x) x)
|
|
((number? x) (number->string x))
|
|
((symbol? x) (symbol->string x))))
|
|
|
|
(define-syntax R
|
|
(syntax-rules ()
|
|
((R arg ...)
|
|
(apply riverctl
|
|
(map stringify `(arg ...))))))
|
|
|
|
(define-syntax R:map
|
|
(syntax-rules ()
|
|
((R:map mode (mod key cmd ...) ...)
|
|
(for-each (lambda (args)
|
|
(apply riverctl
|
|
(map stringify
|
|
(append `(map mode) args))))
|
|
`((mod key cmd ...) ...)))))
|
|
|
|
(define-syntax R:input
|
|
(syntax-rules ()
|
|
((R:input name (val var ...) ...)
|
|
(for-each (lambda (args)
|
|
(apply riverctl
|
|
(map stringify
|
|
(append `(input name) args))))
|
|
`((val var ...) ...)))))
|
|
|
|
(define-syntax R:keyboard-group
|
|
(syntax-rules ()
|
|
((R:keyboard-group name . devices)
|
|
(let ((N (stringify 'name))
|
|
(D (map stringify 'devices)))
|
|
(riverctl "keyboard-group-create" N)
|
|
(for-each (lambda (d)
|
|
(riverctl "keyboard-group-add" N d))
|
|
D)))))
|
|
|
|
(define-syntax handle-exit
|
|
(syntax-rules ()
|
|
((_ body body* ...)
|
|
(install-handler 'exit (lambda () body body* ...)))))
|
|
|
|
(define-syntax handle-idle
|
|
(syntax-rules ()
|
|
((_ tag (event) body body* ...)
|
|
(install-handler tag (lambda (event) body body* ...)))))
|
|
|
|
(define-syntax handle-layout-demand
|
|
(syntax-rules ()
|
|
((_ (views width height tags output) body body* ...)
|
|
(install-handler 'layout-demand (lambda (views width height tags out)
|
|
(let ((output (find (lambda (x) (eq? (output-name x) out)) (outputs))))
|
|
body body* ...
|
|
))))))
|
|
|
|
(define-syntax handle-user-command
|
|
(syntax-rules ()
|
|
((_ (command tags output) body body* ...)
|
|
(install-handler 'user-command (lambda (command tags out)
|
|
(let ((output (find (lambda (x) (eq? (output-name x) out)) (outputs))))
|
|
body body* ...
|
|
))))))
|
|
|
|
(define-syntax handle-new-output
|
|
(syntax-rules ()
|
|
((_ (output) body body* ...)
|
|
(install-handler 'new-output (lambda (out)
|
|
(let ((output (find (lambda (x) (eq? (output-name x) out)) (outputs))))
|
|
body body* ...
|
|
))))))
|