guix-home-manager/home/openbox.scm

openbox.scm

1
;;; Guix Home Manager.
2
;;;
3
;;; Copyright © 2019 Julien Lepiller <julien@lepiller.eu>
4
;;;
5
;;; This program is free software: you can redistribute it and/or modify
6
;;; it under the terms of the GNU General Public License as published by
7
;;; the Free Software Foundation, either version 3 of the License, or
8
;;; (at your option) any later version.
9
;;;
10
;;; This program is distributed in the hope that it will be useful,
11
;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
12
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
13
;;; GNU General Public License for more details.
14
;;;
15
;;; You should have received a copy of the GNU General Public License
16
;;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
17
18
(define-module (home openbox)
19
  #:use-module (guix build utils)
20
  #:use-module (guix build-system trivial)
21
  #:use-module (guix gexp)
22
  #:use-module (guix licenses)
23
  #:use-module (guix packages)
24
  #:use-module (guix records)
25
  #:use-module (gnu packages lxde)
26
  #:use-module (home)
27
  #:use-module (ice-9 match)
28
  #:export (openbox-configuration
29
            openbox-configuration?
30
            openbox-configuration-autostart
31
            openbox-configuration-environ
32
            openbox-configuration-menu
33
            openbox-configuration-rc
34
35
            openbox-menu
36
            openbox-menu-id
37
            openbox-menu-label
38
            opebnox-menu-elements
39
40
            openbox-element-menu
41
            openbox-element-execute
42
43
            openbox-home-type))
44
45
(define-record-type* <openbox-configuration>
46
  openbox-configuration make-openbox-configuration
47
  openbox-configuration?
48
  (autostart     openbox-configuration-autostart
49
                 (default #f))
50
  (environ       openbox-configuration-environ
51
                 (default #f))
52
  (menus         openbox-configuration-menus
53
                 (default '()))
54
  (root-elements openbox-configuration-root-elements
55
                 (default '()))
56
  (rc            openbox-configuration-rc
57
                 (default #f)))
58
59
(define-record-type* <openbox-menu>
60
  openbox-menu make-openbox-menu
61
  openbox-menu?
62
  (id       openbox-menu-id)
63
  (label    openbox-menu-label)
64
  (elements openbox-menu-elements))
65
66
(define-record-type* <openbox-element-menu>
67
  openbox-element-menu make-openbox-element-menu
68
  openbox-element-menu?
69
  (id openbox-element-menu-id))
70
71
(define-record-type* <openbox-element-execute>
72
  openbox-element-execute make-openbox-element-execute
73
  openbox-element-execute?
74
  (label   openbox-element-execute-label)
75
  (command openbox-element-execute-command)
76
  (notify? openbox-element-execute-notify?
77
           (default #t)))
78
79
(define (generate-openbox-menu menus root-menu)
80
  (define (element->item element)
81
    (match element
82
      (($ <openbox-element-menu> id)
83
       `(menu (@ (id ,id))))
84
      (($ <openbox-element-execute> label command notify?)
85
       `(item (@ (label ,label))
86
          (action (@ (name "Execute"))
87
            (command ,command)
88
            ,@(if notify? '(startupnotify (enabled "yes")) '()))))))
89
  #~(begin
90
      (use-modules (sxml simple))
91
      (with-output-to-file #$output
92
         (lambda _
93
           (sxml->xml
94
             `(openbox_menu (@ (xmlns "http://openbox.org/3.4/menu"))
95
                #$(map
96
                   (lambda (menu)
97
                     `(menu (@ (id ,(openbox-menu-id menu)) (label ,(openbox-menu-label menu)))
98
                        ,(map element->item (openbox-menu-elements menu))))
99
                   menus)
100
                (menu (@ (id "root-menu") (label "Openbox 3"))
101
                  #$(map element->item root-menu))))))))
102
103
(define (openbox-autostart autostart)
104
  (match autostart
105
    (#f (plain-file "autostart" ""))
106
    (_ autostart)))
107
108
(define (openbox-environment environ)
109
  (match environ
110
    (#f (plain-file "environ" ""))
111
    (_ environ)))
112
113
(define (openbox-rc rc)
114
  (match rc
115
    (#f (plain-file "rc.xml" ""))
116
    (_ rc)))
117
118
(define openbox-home-type
119
  (home-type
120
    (name 'openbox)
121
    (default-value (openbox-configuration))
122
    (extensions
123
      (list
124
        (home-extension
125
          (target root-home-type)
126
          (compute
127
            (lambda (config)
128
              (match config
129
                (($ <openbox-configuration> autostart environ menus root-elements rc)
130
                 `((".config/openbox/menu.xml"
131
                    ,(computed-file "menu.xml" (generate-openbox-menu menus root-elements)))
132
                   (".config/openbox/autostart" ,(openbox-autostart autostart))
133
                   (".config/openbox/environment" ,(openbox-environment environ))
134
                   (".config/openbox/rc.xml" ,(openbox-rc rc))))))))))))
135