source: project/release/3/wmiirc/trunk/wmiirc.scm @ 8618

Last change on this file since 8618 was 8618, checked in by sjamaan, 12 years ago

Fix copy/paste mistake with read-lines

File size: 10.6 KB
Line 
1;;;; wmiirc.scm
2;
3;; A library for writing wmii configuration scripts
4;;
5;; This wmiirc is for wmii 3.6
6;;
7; Copyright (c) 2008, Peter Bex
8; All rights reserved.
9;
10; Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following
11; conditions are met:
12;
13;   Redistributions of source code must retain the above copyright notice, this list of conditions and the following
14;     disclaimer.
15;   Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following
16;     disclaimer in the documentation and/or other materials provided with the distribution.
17;   Neither the name of the author nor the names of its contributors may be used to endorse or promote
18;     products derived from this software without specific prior written permission.
19;
20; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS
21; OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY
22; AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDERS OR
23; CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
24; CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
25; SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
26; THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
27; OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
28; POSSIBILITY OF SUCH DAMAGE.
29;
30; Please report bugs, suggestions and ideas to the Chicken Trac
31; ticket tracking system (assign tickets to user 'sjamaan'):
32; http://trac.callcc.org
33
34(declare
35 (export wmii:connect wmii:write wmii:read
36         wmii:colrules wmii:colrules-set!
37         wmii:tagrules wmii:tagrules-set!
38         wmii:key-code->string wmii:string->key-code
39         wmii:grabbed-keys wmii:grabbed-keys-set!
40         wmii:event-handlers wmii:event-handlers-set!
41         wmii:client=? wmii:event-loop
42         wmii:color->string wmii:string->color
43         wmii:global-settings wmii:global-settings-set!
44         wmii:tag wmii:tag-settings wmii:tag-settings-set!
45         wmii:change-state wmii:kill wmii:navigate-to wmii:send-to
46         wmii:goto-tag wmii:client-tags wmii:client-tags-set!
47         wmii:tags wmii:clients wmii:write-tab wmii:destroy-tab
48         wmii:tabs wmii:quit wmii:exec))
49
50(use 9p-client)
51
52(define *wmii:connection* #f)
53
54(define (camelcased->dasherized str)
55  (list->string
56   (reverse
57    (string-fold
58     (lambda (c l)
59       (if (char-upper-case? c)
60           (if (not (null? l))
61               (cons (char-downcase c) (cons #\- l))
62               (cons (char-downcase c) l))
63           (cons c l))) '() str))))
64
65(define (dasherized->camelcased str . rest)
66  (let-optionals rest ((initial-caps #f))
67    (let ((pieces (string-split str "-")))
68      (if initial-caps
69          (apply string-append (map string-titlecase pieces))
70          (apply string-append (car pieces) (map string-titlecase (cdr pieces)))))))
71
72(define (wmii:connect . rest)
73  (let-optionals rest ((inport #f)
74                       (outport #f))
75   (set! *wmii:connection*
76         (if (and inport outport)
77             (9p:client-connect inport outport)
78             (call-with-values
79                 (lambda ()
80                   (use unix-sockets)
81                   (unix-connect (sprintf "/tmp/ns.~A.~A/wmii"
82                                          (getenv "USER") (getenv "DISPLAY"))))
83               9p:client-connect)))
84   *wmii:connection*))
85
86(define (wmii:read file)
87  (9p:with-input-from-file *wmii:connection* file read-string))
88
89(define (wmii:read-lines file)
90  (9p:with-input-from-file *wmii:connection* file read-lines))
91
92(define (wmii:write file data)
93  (9p:with-output-to-file *wmii:connection* file (lambda () (display data))))
94
95(define (wmii:alist->rules alist)
96  (apply string-append
97   (map
98    (lambda (rule)
99      (sprintf "/~A/ -> ~A\n"
100               (car rule)
101               (if (pair? (cdr rule))
102                   (string-join (map ->string (cdr rule)) "+")
103                   (->string (cdr rule)))))
104    alist)))
105
106(define (wmii:rules->alist rules)
107  (map
108   (lambda (rule)
109     (let ((result (string-match "^/([^/]+)/\\s*->\\s*(.*)$" rule)))
110       (cons (second result) (string-split (third result) "+"))))
111   rules))
112
113(define (wmii:colrules)
114  (map string->number (wmii:rules->alist (wmii:read-lines "/colrules"))))
115
116(define (wmii:colrules-set! rules)
117  (wmii:write "/colrules" (wmii:alist->rules rules)))
118
119(define (wmii:tagrules)
120  (wmii:rules->alist (wmii:read-lines "/tagrules")))
121
122(define (wmii:tagrules-set! rules)
123  (wmii:write "/tagrules" (wmii:alist->rules rules)))
124
125(define (wmii:key-code->string key-code)
126  (string-join key-code "-"))
127
128(define (wmii:string->key-code str)
129  (string-split str "-"))
130
131(define (wmii:grabbed-keys)
132  (map wmii:string->key-code (wmii:read-lines "/keys")))
133
134(define (wmii:grabbed-keys-set! keys)
135  (9p:with-output-to-file *wmii:connection* "/keys"
136    (lambda ()
137      (for-each
138       (lambda (key)
139         (printf "~a\n" (wmii:key-code->string key)))
140       keys))))
141
142(define *wmii:event-handlers* (list))
143
144(define (wmii:event-handlers)
145  *wmii:event-handlers*)
146
147;; Option for not being smart about grabbed keys?
148(define (wmii:event-handlers-set! handlers . rest)
149  (let-optionals rest ((grab-keys #t)) 
150    (if grab-keys
151        (let loop ((handlers handlers)
152                   (keys '()))
153          (if (null? handlers)
154              (wmii:grabbed-keys-set! keys)
155              (match (car handlers)
156                     ((('key . key-code) . _) (loop (cdr handlers) (cons key-code keys)))
157                     (_ (loop (cdr handlers) keys)))))))
158  (set! *wmii:event-handlers* handlers))
159
160(define (wmii:parse-event line)
161  (let* ((parts (string-split line))
162         (type (string->symbol (camelcased->dasherized (car parts)))))
163    (case type
164      ((key)
165       (cons type (wmii:string->key-code (second parts))))
166      ((urgent-tag not-urgent-tag)
167       (list type (third parts) (string=? (second parts) "Client")))
168      ((urgent not-urgent)
169       (list type (second parts) (string=? (third parts) "Client")))
170      ((client-mouse-down client-click)
171       (list type (second parts) (string->number (third parts))))
172      (else
173       (cons type (cdr parts))))))
174
175(define wmii:client=? string=?)
176
177(define (wmii:handle-event event)
178  (let ((handler (alist-ref event
179                            *wmii:event-handlers*
180                            (lambda (template event)
181                              (if (pair? template)
182                                  (equal? template event)
183                                  (eq? template (car event)))))))
184    (if handler
185        (apply handler event))))
186
187(define (wmii:event-loop . rest)
188  (let-optionals rest ((kill-others #t))
189    (if kill-others (wmii:write "/event" "Start wmiirc")) ;; Kill off any running wmiirc
190    (9p:with-input-from-file *wmii:connection* "/event"
191      (lambda ()
192        (let loop ()
193          (let ((event (wmii:parse-event (read-line))))
194            (unless (equal? event '(start "wmiirc")) ;; Otherwise, return
195                    (condition-case (wmii:handle-event event)
196                                    (exn (9p-server-error)
197                                         (fprintf (current-error-port)
198                                                  "Server error: ~A\n"
199                                                  ((condition-property-accessor 'exn 'message) exn))
200                                         (loop)))
201                    (loop))))))))
202
203(define (wmii:color->string color)
204  (string-append "#" (string-pad (number->string color 16) 6 #\0)))
205
206(define (wmii:string->color str)
207  (string->number (string-drop str 1) 16))
208
209(define (wmii:settings->alist settings)
210 (map (lambda (line)
211        (let* ((contents (string-split line))
212               (setting (cons (string->symbol (car contents)) (cdr contents))))
213          (case (car setting)
214            ((focuscolors normcolors)
215             (cons (car setting) (map wmii:string->color (cdr setting))))
216            (else
217             (if (null? (cddr setting))
218                 (cons (car setting) (cadr setting))
219                 setting)))))
220      (if (pair? settings)
221          settings
222          (string-split settings "\n"))))
223
224(define (wmii:alist->settings alist)
225  (string-join
226   (map (lambda (setting)
227          (case (car setting)
228            ((focuscolors normcolors) (sprintf "~A ~A\n" (car setting) (string-join (map wmii:color->string (cdr setting)))))
229            (else (if (pair? (cdr setting))
230                      (sprintf "~A ~A\n" (car setting) (string-join (cdr setting)))
231                      (sprintf "~A ~A\n" (car setting) (cdr setting))))))
232        alist)))
233
234(define (wmii:global-settings)
235  (wmii:settings->alist (wmii:read "/ctl")))
236
237(define (wmii:global-settings-set! alist)
238  (wmii:write "/ctl" (wmii:alist->settings alist)))
239
240(define (wmii:tag . rest)
241  (let-optionals rest ((tag "sel"))
242    (car (wmii:read-lines (sprintf "/tag/~A/ctl" tag)))))
243
244(define (wmii:tag-settings . rest)
245  (let-optionals rest ((tag "sel"))
246    (wmii:settings->alist
247     (cdr (wmii:read-lines (sprintf "/tag/~A/ctl" tag))))))
248
249(define (wmii:tag-settings-set! alist . rest)
250  (let-optionals rest ((tag "sel"))
251    (wmii:write (sprintf "/tag/~A/ctl" tag) (wmii:alist->settings alist))))
252
253(define (wmii:state-transition->string b)
254  (case b
255    ((#t) "on")
256    ((#f) "off")
257    ((toggle) "toggle")
258    (else (error (sprintf "Unknown state transition type ~S" b)))))
259
260(define (wmii:string->state-transition s)
261  (cond
262   ((string=? s "on") #t)
263   ((string=? s "off") #f)
264   ((string=? s "toggle") 'toggle)
265   (else (error (sprintf "Unknown state transition type ~S" s)))))
266
267;; Unfortunately, there's no wmii:client-settings because this information is
268;; not exported by wmii.
269(define (wmii:change-state state value . rest)
270  (let-optionals rest ((client "sel"))
271    (wmii:write (sprintf "/client/~A/ctl" client)
272                (sprintf "~a ~a" state (wmii:state-transition->string value)))))
273
274(define (wmii:kill . rest)
275  (let-optionals rest ((client "sel"))
276    (wmii:write (sprintf "/client/~A/ctl" client) "kill")))
277
278(define (wmii:navigate-to where . rest)
279  (let-optionals rest ((tag "sel"))
280   (wmii:write (sprintf "/tag/~A/ctl" tag) (sprintf "select ~A" where))))
281
282(define (wmii:send-to direction . rest)
283  (let-optionals rest ((client "sel")
284                       (tag "sel"))
285   (wmii:write (sprintf "/tag/~A/ctl" tag)
286               (sprintf "send ~A ~A" client direction))))
287
288(define (wmii:goto-tag tag)
289  (wmii:write "/ctl" (sprintf "view ~A" tag)))
290
291(define (wmii:client-tags . rest)
292  (let-optionals rest ((client "sel"))
293   (string-split (wmii:read (sprintf "/client/~A/tags" client)) "+")))
294
295(define (wmii:client-tags-set! tags . rest)
296  (let-optionals rest ((client "sel"))
297   (wmii:write (sprintf "/client/~A/tags" client) (string-join tags "+"))))
298
299(define (wmii:tags)
300  (delete "sel" (9p:directory *wmii:connection* "/tag")))
301
302(define (wmii:clients)
303  (delete "sel" (9p:directory *wmii:connection* "/client")))
304
305(define (wmii:write-tab bar tab contents . rest)
306  (let-optionals rest ((colors #f))
307   (wmii:write (sprintf "~A/~A" bar tab)
308               (if colors
309                   (sprintf "~A ~A" (string-join (map wmii:color->string colors)) contents)
310                   contents))))
311
312(define (wmii:destroy-tab bar tab)
313  (9p:delete-file *wmii:connection* (sprintf "~A/~A" bar tab)))
314
315(define (wmii:tabs bar)
316  (9p:directory *wmii:connection* bar))
317
318(define (wmii:quit)
319  (wmii:write "/ctl" "quit"))
320
321(define (wmii:exec cmdline)
322  (wmii:write "/ctl" (sprintf "exec ~A" cmdline)))
Note: See TracBrowser for help on using the repository browser.