ext/ui/SimpleViewInteractor.st
author Jan Vrany <jan.vrany@fit.cvut.cz>
Wed, 12 Jul 2017 09:59:48 +0200
branchjv
changeset 681 61b376859809
parent 660 ac2098963e59
child 696 268bf2c60556
permissions -rw-r--r--
Keyboard mapping: code updated to catch up with KeyboardMap
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
659
1a5c26f6f5b7 Added Smalltalk/X SUnit extension for UI testing
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
diff changeset
     1
"{ Package: 'stx:goodies/sunit/ext/ui' }"
1a5c26f6f5b7 Added Smalltalk/X SUnit extension for UI testing
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
diff changeset
     2
1a5c26f6f5b7 Added Smalltalk/X SUnit extension for UI testing
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
diff changeset
     3
"{ NameSpace: Smalltalk }"
1a5c26f6f5b7 Added Smalltalk/X SUnit extension for UI testing
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
diff changeset
     4
1a5c26f6f5b7 Added Smalltalk/X SUnit extension for UI testing
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
diff changeset
     5
Object subclass:#SimpleViewInteractor
1a5c26f6f5b7 Added Smalltalk/X SUnit extension for UI testing
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
diff changeset
     6
	instanceVariableNames:'view'
1a5c26f6f5b7 Added Smalltalk/X SUnit extension for UI testing
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
diff changeset
     7
	classVariableNames:'DefaultTypeWaitTime DefaultInteractionTimeout'
1a5c26f6f5b7 Added Smalltalk/X SUnit extension for UI testing
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
diff changeset
     8
	poolDictionaries:''
1a5c26f6f5b7 Added Smalltalk/X SUnit extension for UI testing
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
diff changeset
     9
	category:'SUnit-Smalltalk/X-UI Testing-Interactors'
1a5c26f6f5b7 Added Smalltalk/X SUnit extension for UI testing
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
diff changeset
    10
!
1a5c26f6f5b7 Added Smalltalk/X SUnit extension for UI testing
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
diff changeset
    11
1a5c26f6f5b7 Added Smalltalk/X SUnit extension for UI testing
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
diff changeset
    12
1a5c26f6f5b7 Added Smalltalk/X SUnit extension for UI testing
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
diff changeset
    13
!SimpleViewInteractor class methodsFor:'initialization'!
1a5c26f6f5b7 Added Smalltalk/X SUnit extension for UI testing
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
diff changeset
    14
1a5c26f6f5b7 Added Smalltalk/X SUnit extension for UI testing
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
diff changeset
    15
initialize
1a5c26f6f5b7 Added Smalltalk/X SUnit extension for UI testing
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
diff changeset
    16
    "Invoked at system start or when the class is dynamically loaded."
1a5c26f6f5b7 Added Smalltalk/X SUnit extension for UI testing
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
diff changeset
    17
1a5c26f6f5b7 Added Smalltalk/X SUnit extension for UI testing
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
diff changeset
    18
    "/ please change as required (and remove this comment)
1a5c26f6f5b7 Added Smalltalk/X SUnit extension for UI testing
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
diff changeset
    19
1a5c26f6f5b7 Added Smalltalk/X SUnit extension for UI testing
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
diff changeset
    20
    DefaultTypeWaitTime := 100. "/MSecs
1a5c26f6f5b7 Added Smalltalk/X SUnit extension for UI testing
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
diff changeset
    21
    DefaultInteractionTimeout := 2000. "/MSecs
1a5c26f6f5b7 Added Smalltalk/X SUnit extension for UI testing
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
diff changeset
    22
1a5c26f6f5b7 Added Smalltalk/X SUnit extension for UI testing
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
diff changeset
    23
    "Modified: / 31-01-2015 / 08:23:58 / Jan Vrany <jan.vrany@fit.cvut.cz>"
1a5c26f6f5b7 Added Smalltalk/X SUnit extension for UI testing
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
diff changeset
    24
! !
1a5c26f6f5b7 Added Smalltalk/X SUnit extension for UI testing
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
diff changeset
    25
1a5c26f6f5b7 Added Smalltalk/X SUnit extension for UI testing
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
diff changeset
    26
!SimpleViewInteractor class methodsFor:'instance creation'!
1a5c26f6f5b7 Added Smalltalk/X SUnit extension for UI testing
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
diff changeset
    27
1a5c26f6f5b7 Added Smalltalk/X SUnit extension for UI testing
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
diff changeset
    28
for: aView
1a5c26f6f5b7 Added Smalltalk/X SUnit extension for UI testing
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
diff changeset
    29
    ^ aView interactorClass new 
1a5c26f6f5b7 Added Smalltalk/X SUnit extension for UI testing
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
diff changeset
    30
        initializeForView: aView;
1a5c26f6f5b7 Added Smalltalk/X SUnit extension for UI testing
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
diff changeset
    31
        yourself
1a5c26f6f5b7 Added Smalltalk/X SUnit extension for UI testing
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
diff changeset
    32
1a5c26f6f5b7 Added Smalltalk/X SUnit extension for UI testing
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
diff changeset
    33
    "Created: / 20-05-2014 / 09:14:54 / Jan Vrany <jan.vrany@fit.cvut.cz>"
1a5c26f6f5b7 Added Smalltalk/X SUnit extension for UI testing
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
diff changeset
    34
! !
1a5c26f6f5b7 Added Smalltalk/X SUnit extension for UI testing
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
diff changeset
    35
1a5c26f6f5b7 Added Smalltalk/X SUnit extension for UI testing
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
diff changeset
    36
!SimpleViewInteractor methodsFor:'error handling'!
1a5c26f6f5b7 Added Smalltalk/X SUnit extension for UI testing
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
diff changeset
    37
1a5c26f6f5b7 Added Smalltalk/X SUnit extension for UI testing
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
diff changeset
    38
doesNotUnderstand: aMessage
1a5c26f6f5b7 Added Smalltalk/X SUnit extension for UI testing
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
diff changeset
    39
    ^ [ aMessage sendTo: view ] 
1a5c26f6f5b7 Added Smalltalk/X SUnit extension for UI testing
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
diff changeset
    40
        on: Object messageNotUnderstoodSignal 
1a5c26f6f5b7 Added Smalltalk/X SUnit extension for UI testing
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
diff changeset
    41
        do:[:ex | super doesNotUnderstand: aMessage ].
1a5c26f6f5b7 Added Smalltalk/X SUnit extension for UI testing
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
diff changeset
    42
1a5c26f6f5b7 Added Smalltalk/X SUnit extension for UI testing
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
diff changeset
    43
    "Created: / 20-05-2014 / 09:12:31 / Jan Vrany <jan.vrany@fit.cvut.cz>"
1a5c26f6f5b7 Added Smalltalk/X SUnit extension for UI testing
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
diff changeset
    44
! !
1a5c26f6f5b7 Added Smalltalk/X SUnit extension for UI testing
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
diff changeset
    45
1a5c26f6f5b7 Added Smalltalk/X SUnit extension for UI testing
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
diff changeset
    46
!SimpleViewInteractor methodsFor:'initialization'!
1a5c26f6f5b7 Added Smalltalk/X SUnit extension for UI testing
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
diff changeset
    47
1a5c26f6f5b7 Added Smalltalk/X SUnit extension for UI testing
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
diff changeset
    48
initializeForView: aSimpleView
1a5c26f6f5b7 Added Smalltalk/X SUnit extension for UI testing
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
diff changeset
    49
    view := aSimpleView
1a5c26f6f5b7 Added Smalltalk/X SUnit extension for UI testing
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
diff changeset
    50
1a5c26f6f5b7 Added Smalltalk/X SUnit extension for UI testing
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
diff changeset
    51
    "Created: / 20-05-2014 / 09:13:54 / Jan Vrany <jan.vrany@fit.cvut.cz>"
1a5c26f6f5b7 Added Smalltalk/X SUnit extension for UI testing
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
diff changeset
    52
! !
1a5c26f6f5b7 Added Smalltalk/X SUnit extension for UI testing
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
diff changeset
    53
1a5c26f6f5b7 Added Smalltalk/X SUnit extension for UI testing
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
diff changeset
    54
!SimpleViewInteractor methodsFor:'interaction'!
1a5c26f6f5b7 Added Smalltalk/X SUnit extension for UI testing
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
diff changeset
    55
1a5c26f6f5b7 Added Smalltalk/X SUnit extension for UI testing
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
diff changeset
    56
do: aBlock
1a5c26f6f5b7 Added Smalltalk/X SUnit extension for UI testing
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
diff changeset
    57
    "Evaluate given block in view's event queue and wait until block is processed.
1a5c26f6f5b7 Added Smalltalk/X SUnit extension for UI testing
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
diff changeset
    58
     The block is optionally passed the view as first parameter."
1a5c26f6f5b7 Added Smalltalk/X SUnit extension for UI testing
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
diff changeset
    59
1a5c26f6f5b7 Added Smalltalk/X SUnit extension for UI testing
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
diff changeset
    60
    self do: aBlock timeout: DefaultInteractionTimeout.
1a5c26f6f5b7 Added Smalltalk/X SUnit extension for UI testing
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
diff changeset
    61
1a5c26f6f5b7 Added Smalltalk/X SUnit extension for UI testing
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
diff changeset
    62
    "Created: / 31-01-2015 / 08:24:44 / Jan Vrany <jan.vrany@fit.cvut.cz>"
1a5c26f6f5b7 Added Smalltalk/X SUnit extension for UI testing
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
diff changeset
    63
!
1a5c26f6f5b7 Added Smalltalk/X SUnit extension for UI testing
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
diff changeset
    64
1a5c26f6f5b7 Added Smalltalk/X SUnit extension for UI testing
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
diff changeset
    65
do: aBlock timeout: timeout
1a5c26f6f5b7 Added Smalltalk/X SUnit extension for UI testing
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
diff changeset
    66
    "Evaluate given block in view's event queue and wait until block is processed.
1a5c26f6f5b7 Added Smalltalk/X SUnit extension for UI testing
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
diff changeset
    67
     The block is optionally passed the view as first parameter.
1a5c26f6f5b7 Added Smalltalk/X SUnit extension for UI testing
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
diff changeset
    68
     An error is thrown when the block does not finish in given time."
1a5c26f6f5b7 Added Smalltalk/X SUnit extension for UI testing
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
diff changeset
    69
1a5c26f6f5b7 Added Smalltalk/X SUnit extension for UI testing
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
diff changeset
    70
    | blocker1 blocker2 |
1a5c26f6f5b7 Added Smalltalk/X SUnit extension for UI testing
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
diff changeset
    71
1a5c26f6f5b7 Added Smalltalk/X SUnit extension for UI testing
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
diff changeset
    72
    blocker1 := Semaphore new.
1a5c26f6f5b7 Added Smalltalk/X SUnit extension for UI testing
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
diff changeset
    73
    blocker2 := Semaphore new.
1a5c26f6f5b7 Added Smalltalk/X SUnit extension for UI testing
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
diff changeset
    74
660
ac2098963e59 Fixed SimpleViewInteractor>>do:timeout:
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 659
diff changeset
    75
    view sensor pushAction:[ 
659
1a5c26f6f5b7 Added Smalltalk/X SUnit extension for UI testing
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
diff changeset
    76
        blocker1 signal.
1a5c26f6f5b7 Added Smalltalk/X SUnit extension for UI testing
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
diff changeset
    77
        aBlock valueWithOptionalArgument: view.
1a5c26f6f5b7 Added Smalltalk/X SUnit extension for UI testing
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
diff changeset
    78
        blocker2 signal.
1a5c26f6f5b7 Added Smalltalk/X SUnit extension for UI testing
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
diff changeset
    79
    ].
1a5c26f6f5b7 Added Smalltalk/X SUnit extension for UI testing
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
diff changeset
    80
    blocker1 wait.
660
ac2098963e59 Fixed SimpleViewInteractor>>do:timeout:
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 659
diff changeset
    81
    (blocker2 waitWithTimeoutMs: timeout) isNil ifTrue:[ 
ac2098963e59 Fixed SimpleViewInteractor>>do:timeout:
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 659
diff changeset
    82
        self error: 'User action did not finish in ', timeout printString , 'ms'.
ac2098963e59 Fixed SimpleViewInteractor>>do:timeout:
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 659
diff changeset
    83
    ].
659
1a5c26f6f5b7 Added Smalltalk/X SUnit extension for UI testing
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
diff changeset
    84
1a5c26f6f5b7 Added Smalltalk/X SUnit extension for UI testing
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
diff changeset
    85
    "Created: / 31-01-2015 / 08:27:21 / Jan Vrany <jan.vrany@fit.cvut.cz>"
660
ac2098963e59 Fixed SimpleViewInteractor>>do:timeout:
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 659
diff changeset
    86
    "Modified: / 18-07-2016 / 18:56:50 / Jan Vrany <jan.vrany@fit.cvut.cz>"
659
1a5c26f6f5b7 Added Smalltalk/X SUnit extension for UI testing
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
diff changeset
    87
!
1a5c26f6f5b7 Added Smalltalk/X SUnit extension for UI testing
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
diff changeset
    88
1a5c26f6f5b7 Added Smalltalk/X SUnit extension for UI testing
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
diff changeset
    89
type: value
1a5c26f6f5b7 Added Smalltalk/X SUnit extension for UI testing
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
diff changeset
    90
    "Send sequence of key press / key release events to the view.
1a5c26f6f5b7 Added Smalltalk/X SUnit extension for UI testing
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
diff changeset
    91
1a5c26f6f5b7 Added Smalltalk/X SUnit extension for UI testing
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
diff changeset
    92
    If argument is a character, send events for that character.    
1a5c26f6f5b7 Added Smalltalk/X SUnit extension for UI testing
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
diff changeset
    93
    If argument is a string, send events for each character.
1a5c26f6f5b7 Added Smalltalk/X SUnit extension for UI testing
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
diff changeset
    94
    If argument is a symbol, assume it's a single (symbolic) key and
1a5c26f6f5b7 Added Smalltalk/X SUnit extension for UI testing
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
diff changeset
    95
        send press + release with that symbol as key
1a5c26f6f5b7 Added Smalltalk/X SUnit extension for UI testing
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
diff changeset
    96
    If argument is a unspecified collection, send each element recursively.
1a5c26f6f5b7 Added Smalltalk/X SUnit extension for UI testing
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
diff changeset
    97
    "
1a5c26f6f5b7 Added Smalltalk/X SUnit extension for UI testing
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
diff changeset
    98
1a5c26f6f5b7 Added Smalltalk/X SUnit extension for UI testing
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
diff changeset
    99
    self type: value wait: true
1a5c26f6f5b7 Added Smalltalk/X SUnit extension for UI testing
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
diff changeset
   100
1a5c26f6f5b7 Added Smalltalk/X SUnit extension for UI testing
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
diff changeset
   101
    "Created: / 20-05-2014 / 15:14:14 / Jan Vrany <jan.vrany@fit.cvut.cz>"
1a5c26f6f5b7 Added Smalltalk/X SUnit extension for UI testing
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
diff changeset
   102
    "Modified: / 23-07-2014 / 07:43:24 / Jan Vrany <jan.vrany@fit.cvut.cz>"
1a5c26f6f5b7 Added Smalltalk/X SUnit extension for UI testing
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
diff changeset
   103
!
1a5c26f6f5b7 Added Smalltalk/X SUnit extension for UI testing
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
diff changeset
   104
1a5c26f6f5b7 Added Smalltalk/X SUnit extension for UI testing
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
diff changeset
   105
type: value wait: wait
1a5c26f6f5b7 Added Smalltalk/X SUnit extension for UI testing
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
diff changeset
   106
    "Send sequence of key press / key release events to the view.
1a5c26f6f5b7 Added Smalltalk/X SUnit extension for UI testing
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
diff changeset
   107
     If `wait` is true, wait for DefaulWaitTime milliseconds to give
1a5c26f6f5b7 Added Smalltalk/X SUnit extension for UI testing
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
diff changeset
   108
     Workstation a chance to process ecents
1a5c26f6f5b7 Added Smalltalk/X SUnit extension for UI testing
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
diff changeset
   109
1a5c26f6f5b7 Added Smalltalk/X SUnit extension for UI testing
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
diff changeset
   110
    If argument is a character, send events for that character.    
1a5c26f6f5b7 Added Smalltalk/X SUnit extension for UI testing
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
diff changeset
   111
    If argument is a string, send events for each character.
1a5c26f6f5b7 Added Smalltalk/X SUnit extension for UI testing
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
diff changeset
   112
    If argument is a symbol, assume it's a single (symbolic) key and
1a5c26f6f5b7 Added Smalltalk/X SUnit extension for UI testing
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
diff changeset
   113
        send press + release with that symbol as key
1a5c26f6f5b7 Added Smalltalk/X SUnit extension for UI testing
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
diff changeset
   114
    If argument is a unspecified collection, send each element recursively.
1a5c26f6f5b7 Added Smalltalk/X SUnit extension for UI testing
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
diff changeset
   115
    "
1a5c26f6f5b7 Added Smalltalk/X SUnit extension for UI testing
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
diff changeset
   116
1a5c26f6f5b7 Added Smalltalk/X SUnit extension for UI testing
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
diff changeset
   117
    value isCharacter ifTrue:[
1a5c26f6f5b7 Added Smalltalk/X SUnit extension for UI testing
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
diff changeset
   118
        view device simulateKeyboardInput: value inViewId:view id.
1a5c26f6f5b7 Added Smalltalk/X SUnit extension for UI testing
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
diff changeset
   119
    ] ifFalse:[ value isSymbol ifTrue:[
681
61b376859809 Keyboard mapping: code updated to catch up with KeyboardMap
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 660
diff changeset
   120
        | raw modifiers ctrl cmd shift |
61b376859809 Keyboard mapping: code updated to catch up with KeyboardMap
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 660
diff changeset
   121
61b376859809 Keyboard mapping: code updated to catch up with KeyboardMap
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 660
diff changeset
   122
        raw := view device keyboardMap bindingForLogical: value.
61b376859809 Keyboard mapping: code updated to catch up with KeyboardMap
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 660
diff changeset
   123
        raw isNil ifTrue:[ 
61b376859809 Keyboard mapping: code updated to catch up with KeyboardMap
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 660
diff changeset
   124
            | aliases |
659
1a5c26f6f5b7 Added Smalltalk/X SUnit extension for UI testing
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
diff changeset
   125
681
61b376859809 Keyboard mapping: code updated to catch up with KeyboardMap
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 660
diff changeset
   126
            aliases := view device keyboardMap aliasesForLogical: value.
61b376859809 Keyboard mapping: code updated to catch up with KeyboardMap
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 660
diff changeset
   127
            aliases notEmptyOrNil ifTrue:[ 
61b376859809 Keyboard mapping: code updated to catch up with KeyboardMap
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 660
diff changeset
   128
                raw := aliases anElement.
61b376859809 Keyboard mapping: code updated to catch up with KeyboardMap
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 660
diff changeset
   129
            ].
61b376859809 Keyboard mapping: code updated to catch up with KeyboardMap
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 660
diff changeset
   130
        ].
61b376859809 Keyboard mapping: code updated to catch up with KeyboardMap
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 660
diff changeset
   131
        raw isNil ifTrue:[ 
61b376859809 Keyboard mapping: code updated to catch up with KeyboardMap
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 660
diff changeset
   132
            raw := value.
61b376859809 Keyboard mapping: code updated to catch up with KeyboardMap
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 660
diff changeset
   133
        ].
659
1a5c26f6f5b7 Added Smalltalk/X SUnit extension for UI testing
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
diff changeset
   134
        ctrl := cmd := shift := false.
1a5c26f6f5b7 Added Smalltalk/X SUnit extension for UI testing
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
diff changeset
   135
        (raw startsWith: 'Ctrl') ifTrue:[
1a5c26f6f5b7 Added Smalltalk/X SUnit extension for UI testing
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
diff changeset
   136
            ctrl := true.
1a5c26f6f5b7 Added Smalltalk/X SUnit extension for UI testing
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
diff changeset
   137
            modifiers := (modifiers ? 0) | view device ctrlModifierMask.
1a5c26f6f5b7 Added Smalltalk/X SUnit extension for UI testing
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
diff changeset
   138
            raw := raw copyFrom: 5.
1a5c26f6f5b7 Added Smalltalk/X SUnit extension for UI testing
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
diff changeset
   139
        ].
1a5c26f6f5b7 Added Smalltalk/X SUnit extension for UI testing
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
diff changeset
   140
        (raw startsWith: 'Cmd') ifTrue:[
1a5c26f6f5b7 Added Smalltalk/X SUnit extension for UI testing
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
diff changeset
   141
            cmd := true.                 
1a5c26f6f5b7 Added Smalltalk/X SUnit extension for UI testing
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
diff changeset
   142
            modifiers := (modifiers ? 0) | view device metaModifierMask.
1a5c26f6f5b7 Added Smalltalk/X SUnit extension for UI testing
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
diff changeset
   143
            raw := raw copyFrom: 4.
1a5c26f6f5b7 Added Smalltalk/X SUnit extension for UI testing
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
diff changeset
   144
        ].
1a5c26f6f5b7 Added Smalltalk/X SUnit extension for UI testing
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
diff changeset
   145
        (raw startsWith: 'Shift') ifTrue:[
1a5c26f6f5b7 Added Smalltalk/X SUnit extension for UI testing
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
diff changeset
   146
            shift := true.
1a5c26f6f5b7 Added Smalltalk/X SUnit extension for UI testing
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
diff changeset
   147
            modifiers := (modifiers ? 0) | view device shiftModifierMask.
1a5c26f6f5b7 Added Smalltalk/X SUnit extension for UI testing
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
diff changeset
   148
            raw := raw copyFrom: 6.
1a5c26f6f5b7 Added Smalltalk/X SUnit extension for UI testing
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
diff changeset
   149
        ].        
1a5c26f6f5b7 Added Smalltalk/X SUnit extension for UI testing
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
diff changeset
   150
        (raw size == 1 and:[raw first isUppercase]) ifTrue:[ 
1a5c26f6f5b7 Added Smalltalk/X SUnit extension for UI testing
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
diff changeset
   151
             shift := true.
1a5c26f6f5b7 Added Smalltalk/X SUnit extension for UI testing
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
diff changeset
   152
             modifiers := (modifiers ? 0) | view device shiftModifierMask.
1a5c26f6f5b7 Added Smalltalk/X SUnit extension for UI testing
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
diff changeset
   153
             raw := raw first asLowercase codePoint.
1a5c26f6f5b7 Added Smalltalk/X SUnit extension for UI testing
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
diff changeset
   154
        ] ifFalse:[ 
1a5c26f6f5b7 Added Smalltalk/X SUnit extension for UI testing
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
diff changeset
   155
            (raw startsWith: 'Cursor') ifTrue:[ 
1a5c26f6f5b7 Added Smalltalk/X SUnit extension for UI testing
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
diff changeset
   156
                raw := raw copyFrom: 7.
1a5c26f6f5b7 Added Smalltalk/X SUnit extension for UI testing
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
diff changeset
   157
            ].
1a5c26f6f5b7 Added Smalltalk/X SUnit extension for UI testing
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
diff changeset
   158
        ].
1a5c26f6f5b7 Added Smalltalk/X SUnit extension for UI testing
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
diff changeset
   159
        ctrl ifTrue:[ 
1a5c26f6f5b7 Added Smalltalk/X SUnit extension for UI testing
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
diff changeset
   160
            view device sendKeyOrButtonEvent: #keyPress x: 10 y: 10 keyOrButton: #Control_L state: modifiers toViewId: view id.            
1a5c26f6f5b7 Added Smalltalk/X SUnit extension for UI testing
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
diff changeset
   161
        ].
1a5c26f6f5b7 Added Smalltalk/X SUnit extension for UI testing
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
diff changeset
   162
        cmd ifTrue:[ 
1a5c26f6f5b7 Added Smalltalk/X SUnit extension for UI testing
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
diff changeset
   163
            view device sendKeyOrButtonEvent: #keyPress x: 10 y: 10 keyOrButton: #Alt_L state: modifiers toViewId: view id.            
1a5c26f6f5b7 Added Smalltalk/X SUnit extension for UI testing
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
diff changeset
   164
        ].
1a5c26f6f5b7 Added Smalltalk/X SUnit extension for UI testing
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
diff changeset
   165
        shift ifTrue:[ 
1a5c26f6f5b7 Added Smalltalk/X SUnit extension for UI testing
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
diff changeset
   166
            view device sendKeyOrButtonEvent: #keyPress x: 10 y: 10 keyOrButton: #Shift_L state: modifiers toViewId: view id.            
1a5c26f6f5b7 Added Smalltalk/X SUnit extension for UI testing
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
diff changeset
   167
        ].
1a5c26f6f5b7 Added Smalltalk/X SUnit extension for UI testing
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
diff changeset
   168
        view device sendKeyOrButtonEvent: #keyPress x: 10 y: 10 keyOrButton: raw state: modifiers toViewId: view id.
1a5c26f6f5b7 Added Smalltalk/X SUnit extension for UI testing
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
diff changeset
   169
        view device sendKeyOrButtonEvent: #keyRelease x: 10 y: 10 keyOrButton: raw state: modifiers toViewId: view id.
1a5c26f6f5b7 Added Smalltalk/X SUnit extension for UI testing
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
diff changeset
   170
        shift ifTrue:[ 
1a5c26f6f5b7 Added Smalltalk/X SUnit extension for UI testing
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
diff changeset
   171
            view device sendKeyOrButtonEvent: #keyRelease x: 10 y: 10 keyOrButton: #Shift_L state: modifiers toViewId: view id.            
1a5c26f6f5b7 Added Smalltalk/X SUnit extension for UI testing
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
diff changeset
   172
        ].
1a5c26f6f5b7 Added Smalltalk/X SUnit extension for UI testing
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
diff changeset
   173
        cmd ifTrue:[ 
1a5c26f6f5b7 Added Smalltalk/X SUnit extension for UI testing
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
diff changeset
   174
            view device sendKeyOrButtonEvent: #keyRelease x: 10 y: 10 keyOrButton: #Alt_L state: modifiers toViewId: view id.            
1a5c26f6f5b7 Added Smalltalk/X SUnit extension for UI testing
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
diff changeset
   175
        ].
1a5c26f6f5b7 Added Smalltalk/X SUnit extension for UI testing
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
diff changeset
   176
        ctrl ifTrue:[ 
1a5c26f6f5b7 Added Smalltalk/X SUnit extension for UI testing
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
diff changeset
   177
            view device sendKeyOrButtonEvent: #keyRelease x: 10 y: 10 keyOrButton: #Control_L state: modifiers toViewId: view id.            
1a5c26f6f5b7 Added Smalltalk/X SUnit extension for UI testing
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
diff changeset
   178
        ]        
1a5c26f6f5b7 Added Smalltalk/X SUnit extension for UI testing
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
diff changeset
   179
    ] ifFalse:[
1a5c26f6f5b7 Added Smalltalk/X SUnit extension for UI testing
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
diff changeset
   180
        value do:[:each | self type: each wait: false ]
1a5c26f6f5b7 Added Smalltalk/X SUnit extension for UI testing
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
diff changeset
   181
    ]].
1a5c26f6f5b7 Added Smalltalk/X SUnit extension for UI testing
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
diff changeset
   182
1a5c26f6f5b7 Added Smalltalk/X SUnit extension for UI testing
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
diff changeset
   183
    wait ifTrue:[ 
1a5c26f6f5b7 Added Smalltalk/X SUnit extension for UI testing
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
diff changeset
   184
        Delay waitForMilliseconds: DefaultTypeWaitTime  
1a5c26f6f5b7 Added Smalltalk/X SUnit extension for UI testing
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
diff changeset
   185
    ].
1a5c26f6f5b7 Added Smalltalk/X SUnit extension for UI testing
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
diff changeset
   186
1a5c26f6f5b7 Added Smalltalk/X SUnit extension for UI testing
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
diff changeset
   187
    "Created: / 23-07-2014 / 07:35:42 / Jan Vrany <jan.vrany@fit.cvut.cz>"
681
61b376859809 Keyboard mapping: code updated to catch up with KeyboardMap
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 660
diff changeset
   188
    "Modified: / 12-07-2017 / 09:57:46 / Jan Vrany <jan.vrany@fit.cvut.cz>"
660
ac2098963e59 Fixed SimpleViewInteractor>>do:timeout:
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 659
diff changeset
   189
!
ac2098963e59 Fixed SimpleViewInteractor>>do:timeout:
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 659
diff changeset
   190
ac2098963e59 Fixed SimpleViewInteractor>>do:timeout:
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 659
diff changeset
   191
wait
ac2098963e59 Fixed SimpleViewInteractor>>do:timeout:
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 659
diff changeset
   192
    "Wait (block the caller) until all event is the event queue are processed."
ac2098963e59 Fixed SimpleViewInteractor>>do:timeout:
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 659
diff changeset
   193
ac2098963e59 Fixed SimpleViewInteractor>>do:timeout:
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 659
diff changeset
   194
    self do:[] timeout: nil
ac2098963e59 Fixed SimpleViewInteractor>>do:timeout:
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 659
diff changeset
   195
ac2098963e59 Fixed SimpleViewInteractor>>do:timeout:
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 659
diff changeset
   196
    "Created: / 18-07-2016 / 18:58:06 / Jan Vrany <jan.vrany@fit.cvut.cz>"
659
1a5c26f6f5b7 Added Smalltalk/X SUnit extension for UI testing
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
diff changeset
   197
! !
1a5c26f6f5b7 Added Smalltalk/X SUnit extension for UI testing
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
diff changeset
   198
1a5c26f6f5b7 Added Smalltalk/X SUnit extension for UI testing
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
diff changeset
   199
!SimpleViewInteractor methodsFor:'navigation'!
1a5c26f6f5b7 Added Smalltalk/X SUnit extension for UI testing
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
diff changeset
   200
1a5c26f6f5b7 Added Smalltalk/X SUnit extension for UI testing
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
diff changeset
   201
/ aString
1a5c26f6f5b7 Added Smalltalk/X SUnit extension for UI testing
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
diff changeset
   202
    "Return an interactor for subview named `aString`"
1a5c26f6f5b7 Added Smalltalk/X SUnit extension for UI testing
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
diff changeset
   203
1a5c26f6f5b7 Added Smalltalk/X SUnit extension for UI testing
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
diff changeset
   204
    | subviews |
1a5c26f6f5b7 Added Smalltalk/X SUnit extension for UI testing
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
diff changeset
   205
1a5c26f6f5b7 Added Smalltalk/X SUnit extension for UI testing
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
diff changeset
   206
    subviews := view subViews select:[:each | each name = aString ].
1a5c26f6f5b7 Added Smalltalk/X SUnit extension for UI testing
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
diff changeset
   207
    subviews size == 1 ifTrue:[ ^ subviews anElement interactor ].
1a5c26f6f5b7 Added Smalltalk/X SUnit extension for UI testing
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
diff changeset
   208
    subviews isEmpty 
1a5c26f6f5b7 Added Smalltalk/X SUnit extension for UI testing
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
diff changeset
   209
        ifTrue:[ self error: ('No sub-componenents with name ''%1''' bindWith: aString)  ]
1a5c26f6f5b7 Added Smalltalk/X SUnit extension for UI testing
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
diff changeset
   210
        ifFalse: [ self error: ('Multiple sub-componenents with name ''%1''' bindWith: aString) ]
1a5c26f6f5b7 Added Smalltalk/X SUnit extension for UI testing
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
diff changeset
   211
1a5c26f6f5b7 Added Smalltalk/X SUnit extension for UI testing
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
diff changeset
   212
    "Created: / 20-05-2014 / 09:26:18 / Jan Vrany <jan.vrany@fit.cvut.cz>"
1a5c26f6f5b7 Added Smalltalk/X SUnit extension for UI testing
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
diff changeset
   213
    "Modified: / 31-01-2015 / 08:17:16 / Jan Vrany <jan.vrany@fit.cvut.cz>"
1a5c26f6f5b7 Added Smalltalk/X SUnit extension for UI testing
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
diff changeset
   214
! !
1a5c26f6f5b7 Added Smalltalk/X SUnit extension for UI testing
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
diff changeset
   215
1a5c26f6f5b7 Added Smalltalk/X SUnit extension for UI testing
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
diff changeset
   216
!SimpleViewInteractor class methodsFor:'documentation'!
1a5c26f6f5b7 Added Smalltalk/X SUnit extension for UI testing
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
diff changeset
   217
1a5c26f6f5b7 Added Smalltalk/X SUnit extension for UI testing
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
diff changeset
   218
version_HG
1a5c26f6f5b7 Added Smalltalk/X SUnit extension for UI testing
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
diff changeset
   219
1a5c26f6f5b7 Added Smalltalk/X SUnit extension for UI testing
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
diff changeset
   220
    ^ '$Changeset: <not expanded> $'
1a5c26f6f5b7 Added Smalltalk/X SUnit extension for UI testing
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
diff changeset
   221
! !
1a5c26f6f5b7 Added Smalltalk/X SUnit extension for UI testing
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
diff changeset
   222
1a5c26f6f5b7 Added Smalltalk/X SUnit extension for UI testing
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
diff changeset
   223
1a5c26f6f5b7 Added Smalltalk/X SUnit extension for UI testing
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
diff changeset
   224
SimpleViewInteractor initialize!