| 
									
										
										
										
											2008-03-01 17:00:45 -05:00
										 |  |  | IN: ui.commands.tests | 
					
						
							| 
									
										
										
										
											2007-09-20 18:09:08 -04:00
										 |  |  | USING: ui.commands ui.gestures tools.test help.markup io | 
					
						
							| 
									
										
										
										
											2009-01-31 00:52:02 -05:00
										 |  |  | io.streams.string system kernel ;
 | 
					
						
							| 
									
										
										
										
											2007-09-20 18:09:08 -04:00
										 |  |  | 
 | 
					
						
							| 
									
										
										
										
											2015-07-03 12:39:59 -04:00
										 |  |  | { "Press Button 2" } [ T{ button-down f f 2 } gesture>string ] unit-test | 
					
						
							| 
									
										
										
										
											2007-09-20 18:09:08 -04:00
										 |  |  | 
 | 
					
						
							| 
									
										
										
										
											2009-01-31 00:52:02 -05:00
										 |  |  | : com-test-1 ( -- ) ;
 | 
					
						
							| 
									
										
										
										
											2007-09-20 18:09:08 -04:00
										 |  |  | 
 | 
					
						
							|  |  |  | \ com-test-1 H{ } define-command | 
					
						
							|  |  |  | 
 | 
					
						
							| 
									
										
										
										
											2015-07-03 12:39:59 -04:00
										 |  |  | { [ 3 com-test-1 ] } [ 3 \ com-test-1 command-quot ] unit-test | 
					
						
							| 
									
										
										
										
											2007-09-20 18:09:08 -04:00
										 |  |  | 
 | 
					
						
							| 
									
										
										
										
											2009-01-31 00:52:02 -05:00
										 |  |  | : com-test-2 ( -- ) ;
 | 
					
						
							| 
									
										
										
										
											2007-09-20 18:09:08 -04:00
										 |  |  | 
 | 
					
						
							|  |  |  | \ com-test-2 H{ { +nullary+ t } } define-command | 
					
						
							|  |  |  | 
 | 
					
						
							| 
									
										
										
										
											2015-07-03 12:39:59 -04:00
										 |  |  | { [ com-test-2 ] } [ 3 \ com-test-2 command-quot ] unit-test | 
					
						
							| 
									
										
										
										
											2007-09-20 18:09:08 -04:00
										 |  |  | 
 | 
					
						
							|  |  |  | SYMBOL: testing | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | testing "testing" "hey" { | 
					
						
							|  |  |  |     { T{ key-down f { C+ } "x" } com-test-1 } | 
					
						
							|  |  |  | } define-command-map | 
					
						
							|  |  |  | 
 | 
					
						
							| 
									
										
										
										
											2009-01-31 00:52:02 -05:00
										 |  |  | os macosx? [ | 
					
						
							|  |  |  |     [ "⌘A" ] [ T{ key-down f { A+ } "a" } gesture>string ] unit-test | 
					
						
							|  |  |  |     [ "B" ] [ T{ key-down f f "b" } gesture>string ] unit-test | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  |     [ "⌃X" ] [ | 
					
						
							|  |  |  |         [ | 
					
						
							|  |  |  |             { $command testing "testing" com-test-1 } print-element | 
					
						
							|  |  |  |         ] with-string-writer | 
					
						
							|  |  |  |     ] unit-test | 
					
						
							|  |  |  | ] [ | 
					
						
							|  |  |  |     [ "A+a" ] [ T{ key-down f { A+ } "a" } gesture>string ] unit-test | 
					
						
							|  |  |  |     [ "b" ] [ T{ key-down f f "b" } gesture>string ] unit-test | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  |     [ "C+x" ] [ | 
					
						
							|  |  |  |         [ | 
					
						
							|  |  |  |             { $command testing "testing" com-test-1 } print-element | 
					
						
							|  |  |  |         ] with-string-writer | 
					
						
							|  |  |  |     ] unit-test | 
					
						
							|  |  |  | ] if
 | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | : com-foo. ( -- ) ;
 | 
					
						
							|  |  |  | 
 | 
					
						
							| 
									
										
										
										
											2015-07-03 12:39:59 -04:00
										 |  |  | { "Foo" } [ \ com-foo. command-name ] unit-test |