system-configuration/homes/modules/gnu/home/services/openbox.scm

openbox.scm

1
(define-module (gnu home services openbox)
2
  #:use-module (guix build utils)
3
  #:use-module (guix gexp)
4
  #:use-module (guix licenses)
5
  #:use-module (guix packages)
6
  #:use-module (guix records)
7
  #:use-module (gnu home services)
8
  #:use-module (ice-9 match)
9
  #:export (home-openbox-configuration
10
            home-openbox-configuration?
11
            home-openbox-configuration-autostart
12
            home-openbox-configuration-environ
13
            home-openbox-configuration-menu
14
            home-openbox-configuration-rc
15
            
16
            home-openbox-menu
17
            home-openbox-menu-id
18
            home-openbox-menu-label
19
            home-opebnox-menu-elements
20
            
21
            home-openbox-element-menu
22
            home-openbox-element-execute
23
            
24
            home-openbox-service-type))
25
26
(define-record-type* <home-openbox-configuration>
27
  home-openbox-configuration make-home-openbox-configuration
28
  home-openbox-configuration?
29
  (autostart     home-openbox-configuration-autostart
30
                 (default #f))
31
  (environ       home-openbox-configuration-environ
32
                 (default #f))
33
  (menus         home-openbox-configuration-menus
34
                 (default '()))
35
  (root-elements home-openbox-configuration-root-elements
36
                 (default '()))
37
  (rc            home-openbox-configuration-rc
38
                 (default #f)))
39
40
(define-record-type* <home-openbox-menu>
41
  home-openbox-menu make-home-openbox-menu
42
  home-openbox-menu?
43
  (id       home-openbox-menu-id)
44
  (label    home-openbox-menu-label)
45
  (elements home-openbox-menu-elements))
46
47
(define-record-type* <home-openbox-element-menu>
48
  home-openbox-element-menu make-home-openbox-element-menu
49
  home-openbox-element-menu?
50
  (id home-openbox-element-menu-id))
51
52
(define-record-type* <home-openbox-element-execute>
53
  home-openbox-element-execute make-home-openbox-element-execute
54
  home-openbox-element-execute?
55
  (label   openbox-element-execute-label)
56
  (command openbox-element-execute-command)
57
  (notify? openbox-element-execute-notify?
58
           (default #t)))
59
60
(define (generate-openbox-menu menus root-menu)
61
  (define (element->item element)
62
    (match element
63
      (($ <home-openbox-element-menu> id)
64
       `(menu (@ (id ,id))))
65
      (($ <home-openbox-element-execute> label command notify?)
66
       `(item (@ (label ,label))
67
          (action (@ (name "Execute"))
68
            (command ,command)
69
            ,@(if notify? '(startupnotify (enabled "yes")) '()))))))
70
  #~(begin
71
      (use-modules (sxml simple))
72
      (with-output-to-file #$output
73
         (lambda _
74
           (sxml->xml
75
             `(openbox_menu (@ (xmlns "http://openbox.org/3.4/menu"))
76
                #$(map
77
                   (lambda (menu)
78
                     `(menu (@ (id ,(home-openbox-menu-id menu)) (label ,(home-openbox-menu-label menu)))
79
                        ,(map element->item (home-openbox-menu-elements menu))))
80
                   menus)
81
                (menu (@ (id "root-menu") (label "Openbox 3"))
82
                  #$(map element->item root-menu))))))))
83
84
(define (openbox-autostart autostart)
85
  (match autostart
86
    (#f (plain-file "autostart" ""))
87
    (_ autostart)))
88
89
(define (openbox-environment environ)
90
  (match environ
91
    (#f (plain-file "environ" ""))
92
    (_ environ)))
93
94
(define (openbox-rc rc)
95
  (match rc
96
    (#f (plain-file "rc.xml" ""))
97
    (_ rc)))
98
99
(define (add-openbox-configuration config)
100
  (match config
101
    (($ <home-openbox-configuration> autostart environ menus root-elements rc)
102
     `((".config/openbox/menu.xml"
103
        ,(computed-file "menu.xml" (generate-openbox-menu menus root-elements)))
104
       (".config/openbox/autostart" ,(openbox-autostart autostart))
105
       (".config/openbox/environment" ,(openbox-environment environ))
106
       (".config/openbox/rc.xml" ,(openbox-rc rc))))))
107
108
(define home-openbox-service-type
109
  (service-type (name 'home-openbox)
110
                (extensions
111
                 (list (service-extension
112
                        home-files-service-type
113
                        add-openbox-configuration)))
114
                (default-value (home-openbox-configuration))
115
                (description "Configure Openbox")))
116