test/test-event.sgl

1(import (sigil test)

2 (sigil tui event))

4(test-group "event parsing"

6 (test-group "printable characters"

7 (test "single ASCII char"

8 (let ((events (parse-input (make-parser-state) #u8(97)))) ;; 'a'

9 (assert-equal 1 (length events))

10 (assert-true (key-event? (car events)))

11 (assert-equal #\a (key-event-key (car events)))

12 (assert-equal #f (key-event-modifier (car events)))))

14 (test "multiple ASCII chars"

15 (let ((events (parse-input (make-parser-state) #u8(104 105)))) ;; "hi"

16 (assert-equal 2 (length events))

17 (assert-equal #\h (key-event-key (car events)))

18 (assert-equal #\i (key-event-key (cadr events))))))

20 (test-group "control keys"

21 (test "Ctrl+A"

22 (let ((events (parse-input (make-parser-state) #u8(1))))

23 (assert-equal 1 (length events))

24 (assert-equal #\a (key-event-key (car events)))

25 (assert-equal 'ctrl (key-event-modifier (car events)))))

27 (test "Ctrl+C"

28 (let ((events (parse-input (make-parser-state) #u8(3))))

29 (assert-equal #\c (key-event-key (car events)))

30 (assert-equal 'ctrl (key-event-modifier (car events)))))

32 (test "tab"

33 (let ((events (parse-input (make-parser-state) #u8(9))))

34 (assert-equal 'tab (key-event-key (car events)))))

36 (test "enter"

37 (let ((events (parse-input (make-parser-state) #u8(13))))

38 (assert-equal 'enter (key-event-key (car events)))))

40 (test "backspace"

41 (let ((events (parse-input (make-parser-state) #u8(127))))

42 (assert-equal 'backspace (key-event-key (car events))))))

44 (test-group "arrow keys"

45 (test "up arrow"

46 (let ((events (parse-input (make-parser-state) #u8(27 91 65))))

47 (assert-equal 1 (length events))

48 (assert-equal 'up (key-event-key (car events)))))

50 (test "down arrow"

51 (let ((events (parse-input (make-parser-state) #u8(27 91 66))))

52 (assert-equal 'down (key-event-key (car events)))))

54 (test "right arrow"

55 (let ((events (parse-input (make-parser-state) #u8(27 91 67))))

56 (assert-equal 'right (key-event-key (car events)))))

58 (test "left arrow"

59 (let ((events (parse-input (make-parser-state) #u8(27 91 68))))

60 (assert-equal 'left (key-event-key (car events))))))

62 (test-group "special keys"

63 (test "home"

64 (let ((events (parse-input (make-parser-state) #u8(27 91 72))))

65 (assert-equal 'home (key-event-key (car events)))))

67 (test "end"

68 (let ((events (parse-input (make-parser-state) #u8(27 91 70))))

69 (assert-equal 'end (key-event-key (car events)))))

71 (test "delete"

72 (let ((events (parse-input (make-parser-state) #u8(27 91 51 126))))

73 (assert-equal 'delete (key-event-key (car events)))))

75 (test "page-up"

76 (let ((events (parse-input (make-parser-state) #u8(27 91 53 126))))

77 (assert-equal 'page-up (key-event-key (car events)))))

79 (test "page-down"

80 (let ((events (parse-input (make-parser-state) #u8(27 91 54 126))))

81 (assert-equal 'page-down (key-event-key (car events))))))

83 (test-group "function keys"

84 (test "F1 via SS3"

85 (let ((events (parse-input (make-parser-state) #u8(27 79 80))))

86 (assert-equal 'f1 (key-event-key (car events)))))

88 (test "F5"

89 ;; ESC [ 1 5 ~

90 (let ((events (parse-input (make-parser-state) #u8(27 91 49 53 126))))

91 (assert-equal 'f5 (key-event-key (car events)))))

93 (test "F12"

94 ;; ESC [ 2 4 ~

95 (let ((events (parse-input (make-parser-state) #u8(27 91 50 52 126))))

96 (assert-equal 'f12 (key-event-key (car events))))))

98 (test-group "alt keys"

99 (test "Alt+a"

100 ;; ESC a

101 (let ((events (parse-input (make-parser-state) #u8(27 97))))

102 (assert-equal 1 (length events))

103 (assert-equal #\a (key-event-key (car events)))

104 (assert-equal 'alt (key-event-modifier (car events))))))

105

106 (test-group "mouse SGR"

107 (test "mouse press"

108 ;; ESC [ < 0 ; 10 ; 5 M

109 (let ((events (parse-input (make-parser-state)

110 #u8(27 91 60 48 59 49 48 59 53 77))))

111 (assert-equal 1 (length events))

112 (assert-true (mouse-event? (car events)))

113 (assert-equal 'press (mouse-event-type (car events)))

114 (assert-equal 10 (mouse-event-col (car events)))

115 (assert-equal 5 (mouse-event-row (car events)))))

116

117 (test "mouse release"

118 ;; ESC [ < 0 ; 10 ; 5 m

119 (let ((events (parse-input (make-parser-state)

120 #u8(27 91 60 48 59 49 48 59 53 109))))

121 (assert-equal 'release (mouse-event-type (car events)))))

122

123 (test "scroll up"

124 ;; ESC [ < 64 ; 1 ; 1 M

125 (let ((events (parse-input (make-parser-state)

126 #u8(27 91 60 54 52 59 49 59 49 77))))

127 (assert-equal 'scroll-up (mouse-event-type (car events)))))

128

129 (test "scroll down"

130 ;; ESC [ < 65 ; 1 ; 1 M

131 (let ((events (parse-input (make-parser-state)

132 #u8(27 91 60 54 53 59 49 59 49 77))))

133 (assert-equal 'scroll-down (mouse-event-type (car events))))))

134

135 (test-group "multi-event bytevectors"

136 (test "two characters in one read"

137 (let ((events (parse-input (make-parser-state) #u8(97 98))))

138 (assert-equal 2 (length events))

139 (assert-equal #\a (key-event-key (car events)))

140 (assert-equal #\b (key-event-key (cadr events)))))

141

142 (test "char then arrow key"

143 ;; 'x' then ESC [ A

144 (let ((events (parse-input (make-parser-state) #u8(120 27 91 65))))

145 (assert-equal 2 (length events))

146 (assert-equal #\x (key-event-key (car events)))

147 (assert-equal 'up (key-event-key (cadr events))))))

148

149 (test-group "incomplete sequence buffering"

150 (test "split ESC sequence across reads"

151 (let ((state (make-parser-state)))

152 ;; First read: just ESC [

153 (let ((events1 (parse-input state #u8(27 91))))

154 (assert-equal 0 (length events1)))

155 ;; Second read: the final byte

156 (let ((events2 (parse-input state #u8(65))))

157 (assert-equal 1 (length events2))

158 (assert-equal 'up (key-event-key (car events2)))))))

159

160 (test-group "backtab"

161 (test "Shift+Tab"

162 ;; ESC [ Z

163 (let ((events (parse-input (make-parser-state) #u8(27 91 90))))

164 (assert-equal 'backtab (key-event-key (car events)))))))