test/keyboard-group.sgl

1(import (sigil async) (sigil io) (sigil process)

2 (sigil wm dispatch) (sigil wm host) (sigil wm input) (sigil wm scene) (sigil wm model) (sigil wm repl))

3(define host (start-host! protocols: 2))

4(define owner (make-dispatcher))

5(define errors '())

6(define stopped? #f)

7(define keys '())

8(define focus-results '())

9(define observations '())

10(define configurations '())

11(define extents '())

12(define binding-presses 0)

13(define delay-forward? #f)

14(define last-plan #f)

15(define applied-plan #f)

16(define windows '())

17(define (report exception)

18 (set! errors (cons exception errors))

19 (write exception) (newline) (stop-host! host))

20(set-key-hook! host

21 (lambda (event)

22 (dispatcher-call! owner

23 (lambda ()

24 (if (= (input-event-code event) 30)

25 (begin

26 (when (= (input-event-state event) 1)

27 (set! binding-presses (+ binding-presses 1))

28 (focus-window! host (if (odd? binding-presses) 0 (car windows)))

29 (sleep 0.02))

30 (drop))

31 (begin

32 (when (= (input-event-state event) 1)

33 (set! keys (cons (input-event-keysyms event) keys)))

34 (when delay-forward? (sleep 0.05))

35 (forward event)))))))

36(on-event! host

37 (lambda (event)

38 (dispatcher-enqueue! owner

39 (lambda (event)

40 (let ((id (event-ref event id:)))

41 (case (event-type event)

42 ((ready)

43 (configure-keyboard! host 1 "us,gr" 25 600 group: 1 fixed-group?: #t)

44 (set-seat-capabilities! host 3))

45 ((stopped) (set! stopped? #t) (dispatcher-close! owner))

46 ((virtual-device-request) (reply-request! host id #t))

47 ((device-added)

48 (when (= (event-ref event device-type:) 0)

49 (configure-keyboard! host id "us,gr" 25 600 group: 1 fixed-group?: #t)))

50 ((output-added)

51 (configure-output! host id

52 (dict enabled: #t x: 0 y: 0 scale: 1 transform: 0 mode: -1 width: 960 height: 640 refresh: 60000)))

53 ((output-configured)

54 (display "WAYLAND_SOCKET=") (display (host-socket host)) (newline) (flush-output-port))

55 ((window-initial) (configure-window! host id 360 240))

56 ((window-mapped)

57 (set! windows (cons id windows))

58 (set! last-plan (submit-plan! host

59 (make-scene-plan (list (placement window: id box: (rect x: 0 y: 0 width: 360 height: 240))) id 200))))

60 ((window-unmapped window-destroyed)

61 (set! windows (filter (lambda (window) (not (= window id))) windows)))

62 ((transaction-applied) (set! applied-plan id))

63 ((focus-request-result) (set! focus-results (cons event focus-results)))

64 ((configuration-result) (set! configurations (cons event configurations)))

65 ((window-observation) (set! observations (cons event observations)))

66 ((window-observation-geometry) (set! extents (cons event extents)))

67 ((command-rejected) (error "unexpected keyboard probe command rejection" (event-raw event))))))

68 event report)))

69(with-async

70 (let ((repl (start-repl! host (getenv "SIGIL_WM_REPL") (interaction-environment))))

71 (go (run-host! host))

72 (go

73 (let loop ()

74 (dispatcher-wait! owner)

75 (dispatcher-drain! owner)

76 (unless stopped? (loop)))

77 (stop-repl! repl))))

78(unless (and (null? errors)

79 (every (lambda (index) (= (host-statistic host index) 0)) '(1 2 3 4)))

80 (error "keyboard group probe failed" errors))

81(display "KEYBOARD_GROUP_HOST=PASS\n")