source: project/release/4/bb/trunk/tests/shell.scm @ 17980

Last change on this file since 17980 was 17980, checked in by felix winkelmann, 9 years ago

added tests to bb

File size: 859 bytes
Line 
1;;;; shell.scm
2
3
4(require-extension extras posix srfi-17 bb)
5
6(bb:init)
7
8(define width 300)
9(define height 150)
10
11(define w (bb:make-widget 'window width height))
12
13(define str #<<EOF
14LLLLLLLLLLLLLJJJJJJJ
15LLLLLLLLLLLLLJJJJJJJ
16LLLLLLLLLLLLLJJJJJJJ
17EEEEEEEEEEEEEEEEEEEE
18EOF
19)
20
21(define widgets
22  (bb:group
23   w
24   (lambda ()
25     (bb:make-widgets str width height) ) ) )
26
27(define lst (cdr (assq #\L widgets)))
28(define entry (cdr (assq #\E widgets)))
29
30(set! (bb:property entry 'callback)
31  (lambda ()
32    (let ([cmd (bb:property entry 'text)])
33      (bb:add! lst (string-append "@i@." cmd))
34      (set! (bb:property entry 'text) "")
35      (with-input-from-pipe 
36       cmd
37       (lambda ()
38         (let loop ()
39           (let ([ln (read-line)])
40             (unless (eof-object? ln)
41               (bb:add! lst (string-append "@." ln)) 
42               (loop) ) ) ) ) ) ) ) )
43
44(bb:show w)
45(bb:run)
Note: See TracBrowser for help on using the repository browser.