;;; Guix Home Manager.
;;;
;;; Copyright © 2019 Julien Lepiller <julien@lepiller.eu>
;;;
;;; This program 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.
;;;
;;; This program 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 this program.  If not, see <http://www.gnu.org/licenses/>.

(define-module (home openbox)
  #:use-module (guix build utils)
  #:use-module (guix build-system trivial)
  #:use-module (guix gexp)
  #:use-module (guix licenses)
  #:use-module (guix packages)
  #:use-module (guix records)
  #:use-module (gnu packages lxde)
  #:use-module (home)
  #:use-module (ice-9 match)
  #:export (openbox-configuration
            openbox-configuration?
            openbox-configuration-autostart
            openbox-configuration-environ
            openbox-configuration-menu
            openbox-configuration-rc
            
            openbox-menu
            openbox-menu-id
            openbox-menu-label
            opebnox-menu-elements
            
            openbox-element-menu
            openbox-element-execute
            
            openbox-home-type))

(define-record-type* <openbox-configuration>
  openbox-configuration make-openbox-configuration
  openbox-configuration?
  (autostart     openbox-configuration-autostart
                 (default #f))
  (environ       openbox-configuration-environ
                 (default #f))
  (menus         openbox-configuration-menus
                 (default '()))
  (root-elements openbox-configuration-root-elements
                 (default '()))
  (rc            openbox-configuration-rc
                 (default #f)))

(define-record-type* <openbox-menu>
  openbox-menu make-openbox-menu
  openbox-menu?
  (id       openbox-menu-id)
  (label    openbox-menu-label)
  (elements openbox-menu-elements))

(define-record-type* <openbox-element-menu>
  openbox-element-menu make-openbox-element-menu
  openbox-element-menu?
  (id openbox-element-menu-id))

(define-record-type* <openbox-element-execute>
  openbox-element-execute make-openbox-element-execute
  openbox-element-execute?
  (label   openbox-element-execute-label)
  (command openbox-element-execute-command)
  (notify? openbox-element-execute-notify?
           (default #t)))

(define (generate-openbox-menu menus root-menu)
  (define (element->item element)
    (match element
      (($ <openbox-element-menu> id)
       `(menu (@ (id ,id))))
      (($ <openbox-element-execute> label command notify?)
       `(item (@ (label ,label))
          (action (@ (name "Execute"))
            (command ,command)
            ,@(if notify? '(startupnotify (enabled "yes")) '()))))))
  #~(begin
      (use-modules (sxml simple))
      (with-output-to-file #$output
         (lambda _
           (sxml->xml
             `(openbox_menu (@ (xmlns "http://openbox.org/3.4/menu"))
                #$(map
                   (lambda (menu)
                     `(menu (@ (id ,(openbox-menu-id menu)) (label ,(openbox-menu-label menu)))
                        ,(map element->item (openbox-menu-elements menu))))
                   menus)
                (menu (@ (id "root-menu") (label "Openbox 3"))
                  #$(map element->item root-menu))))))))

(define (openbox-autostart autostart)
  (match autostart
    (#f (plain-file "autostart" ""))
    (_ autostart)))

(define (openbox-environment environ)
  (match environ
    (#f (plain-file "environ" ""))
    (_ environ)))

(define (openbox-rc rc)
  (match rc
    (#f (plain-file "rc.xml" ""))
    (_ rc)))

(define openbox-home-type
  (home-type
    (name 'openbox)
    (default-value (openbox-configuration))
    (extensions
      (list
        (home-extension
          (target root-home-type)
          (compute
            (lambda (config)
              (match config
                (($ <openbox-configuration> autostart environ menus root-elements rc)
                 `((".config/openbox/menu.xml"
                    ,(computed-file "menu.xml" (generate-openbox-menu menus root-elements)))
                   (".config/openbox/autostart" ,(openbox-autostart autostart))
                   (".config/openbox/environment" ,(openbox-environment environ))
                   (".config/openbox/rc.xml" ,(openbox-rc rc))))))))))))