;;;
;;; 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* ...
         ))))))