aboutsummaryrefslogtreecommitdiffstats
path: root/oni/home/services/herbstluftwm.scm
blob: e69a17c10a51f03ecd52316a870f144e08fe073d (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
(define-module (oni home services herbstluftwm)
  #:use-module (gnu services configuration)
  #:use-module (gnu packages wm)
  #:use-module (gnu packages shells)
  #:use-module (gnu home services)
  #:use-module (gnu home services utils)
  #:use-module (guix packages)
  #:use-module (guix gexp)
  #:use-module (oni home services xsession)
  #:use-module (srfi srfi-1)

  #:export (home-herbstluftwm-service-type
            home-herbstluftwm-configuration))

(define-configuration/no-serialization home-herbstluftwm-configuration
  (package
   (package herbstluftwm)
   "Package use for setting herbstluftwm")
  (mouse-bindings
   (alist '())
   "Mouse bindings")
  (settings
   (alist '())
   "Settings")
  (tags
   (list '(1 2 3 4 5 6 7 8 9 0))
   "Tags")
  (tag-keys
   (list '(1 2 3 4 5 6 7 8 9 0))
   "Keys for the tags")
  (attributes
   (alist '())
   "Attributes to set")
  (rules
   (list '())
   "Rules to apply")
  (padding
   (list '(0 0 0 0 0))
   "Padding to apply to the monitor")
  (layouts
   (alist '())
   "Layouts to load for tags")
  (extra
   (list '())
   "Extra commands"))

(define (add-herbstluftwm-packages config)
  (list (home-herbstluftwm-configuration-package config)))

(define* (mixed-executable-file name #:key guile #:rest text)
  "Return an object representing store file NAME containing TEXT.  TEXT is a
sequence of strings and file-like objects, as in:

  (mixed-text-file \"profile\"
                   \"export PATH=\" coreutils \"/bin:\" grep \"/bin\")

This is the declarative counterpart of 'text-file*'."
  (define build
    (let ((text (if guile (drop text 2) text)))
      (gexp (call-with-output-file (ungexp output "out")
              (lambda (port)
                (set-port-encoding! port "UTF-8")
                (display (string-append (ungexp-splicing text)) port)
                (chmod port #o555))))))

  (computed-file name build #:guile guile))

(define (home-herbstluftwm-autostart-file config)
  (apply mixed-executable-file
         "autostart"
         "#!" zsh "/bin/zsh\n"
         "herbstclient emit_hook reload\n"
         "herbstclient keyunbind --all\n"
         (let ((tags (home-herbstluftwm-configuration-tags config)))
           (append (list "herbstclient mouseunbind --all\n")
                   (map (lambda (binding)
                          (format #f "herbstclient mousebind ~a ~a\n"
                                  (car binding) (cdr binding)))
                        (home-herbstluftwm-configuration-mouse-bindings config))
                   (map (lambda (setting)
                          (format #f "herbstclient set ~s ~s\n"
                                  (car setting) (cdr setting)))
                        (home-herbstluftwm-configuration-settings config))
                   (map (lambda (tag)
                          (format #f "herbstclient add ~s\n" tag))
                        tags)
                   (map (lambda (key tag)
                          (format #f "herbstclient keybind Mod4-~a use ~s\n" key tag))
                        (take (home-herbstluftwm-configuration-tag-keys config)
                              (length tags))
                        tags)
                   (if (> (length tags) 0)
                       (list "herbstclient merge_tag default\n")
                       '())
                   (map (lambda (attribute-pair)
                          (format #f "herbstclient attr ~a ~s\n"
                                  (string-join (map symbol->string (car attribute-pair)) ".")
                                  (cdr attribute-pair)))
                        (home-herbstluftwm-configuration-attributes config))
                   (list "herbstclient unrule -F\n")
                   (map (lambda (rule)
                          (format #f "herbstclient rule ~a\n"
                                  (string-join rule " ")))
                        (home-herbstluftwm-configuration-rules config))
                   (list "herbstclient unlock\n"
                         (format #f "herbstclient pad ~a\n"
                                 (string-join (map number->string (home-herbstluftwm-configuration-padding config)) " ")))
                   (map (lambda (layout-pair)
                          (format #f "herbstclient load ~s '~s'\n"
                                  (car layout-pair)
                                  (cdr layout-pair)))
                        (home-herbstluftwm-configuration-layouts config))
                   (map (lambda (line)
                          (format #f "herbstclient ~a\n" line))
                        (home-herbstluftwm-configuration-extra config))))))

(define (add-herbstluftwm-executable config)
  (home-xsession-extension
   (wm
    (list
     (mixed-text-file
      "xsession"
      "exec " herbstluftwm "/bin/herbstluftwm --autostart " (home-herbstluftwm-autostart-file config))))))

(define home-herbstluftwm-service-type
  (service-type
   (name 'home-herbstluftwm)
   (extensions
    (list (service-extension
           home-profile-service-type
           add-herbstluftwm-packages)
          (service-extension
           home-xsession-service-type
           add-herbstluftwm-executable)))
   (compose identity)
   (default-value (home-herbstluftwm-configuration))
   (description "Install and configure herbstluftwm.")))