FlyByWindowInformation.st
changeset 2300 afddc24415dc
child 2314 e65082256c46
equal deleted inserted replaced
2299:fff41ffaaf26 2300:afddc24415dc
       
     1 "{ Package: 'stx:libtool2' }"
       
     2 
       
     3 FlyByHelp subclass:#FlyByWindowInformation
       
     4 	instanceVariableNames:'lastApplication lastView cleanupAction finishSemaphore'
       
     5 	classVariableNames:''
       
     6 	poolDictionaries:''
       
     7 	category:'Interface-Help'
       
     8 !
       
     9 
       
    10 !FlyByWindowInformation class methodsFor:'documentation'!
       
    11 
       
    12 examples
       
    13 "
       
    14     self shownInformationOfViewUnderMouseUntilButtonIsPressed
       
    15 "
       
    16 !
       
    17 
       
    18 shownInformationOfViewUnderMouseUntilButtonIsPressed
       
    19     self start waitUntilFinished
       
    20 
       
    21     "
       
    22      self shownInformationOfViewUnderMouseUntilButtonIsPressed
       
    23     "
       
    24 ! !
       
    25 
       
    26 !FlyByWindowInformation methodsFor:'accessing'!
       
    27 
       
    28 cleanupAction:something
       
    29     cleanupAction := something.
       
    30 !
       
    31 
       
    32 lastApplication
       
    33     ^ lastApplication
       
    34 !
       
    35 
       
    36 lastView
       
    37     ^ lastView
       
    38 ! !
       
    39 
       
    40 !FlyByWindowInformation methodsFor:'event handling'!
       
    41 
       
    42 buttonMotion:state x:x y:y view:aView
       
    43     super buttonMotion:state x:x y:y view:aView.
       
    44     ^ true
       
    45 !
       
    46 
       
    47 buttonPress:button x:x y:y view:aView
       
    48     self stop.
       
    49     ^ true
       
    50 !
       
    51 
       
    52 keyPress:key x:x y:y view:aView
       
    53     |obj action|
       
    54 
       
    55     key == #Escape ifTrue:[
       
    56         self stop.
       
    57         ^ true
       
    58     ].
       
    59 
       
    60     key asLowercase == $a ifTrue:[
       
    61         obj := lastApplication
       
    62     ].
       
    63     key asLowercase == $m ifTrue:[
       
    64         obj := lastApplication masterApplication
       
    65     ].
       
    66     key asLowercase == $v ifTrue:[
       
    67         obj := lastView
       
    68     ].
       
    69     key asLowercase == $t ifTrue:[
       
    70         obj := lastView topView
       
    71     ].
       
    72     obj notNil ifTrue:[
       
    73         key isLowercase ifTrue:[
       
    74             action := [ obj inspect ].
       
    75         ] ifFalse:[
       
    76             action := [ obj browse ].
       
    77         ].
       
    78         action forkAt:8.
       
    79     ].
       
    80 
       
    81     ^ true
       
    82 ! !
       
    83 
       
    84 !FlyByWindowInformation methodsFor:'help texts'!
       
    85 
       
    86 helpTextFor:aView at:aPointOrNil
       
    87     lastView := aView.
       
    88     lastApplication := aView application.
       
    89 
       
    90     ^ String streamContents:[:s |
       
    91         s nextPutLine:('View: ' , aView class name).
       
    92         aView topView ~~ aView ifTrue:[
       
    93             s nextPutLine:('Topview: ' , aView topView class name).
       
    94         ].
       
    95         lastApplication notNil ifTrue:[
       
    96             s nextPutLine:('Application: ' , lastApplication class name).
       
    97             lastApplication masterApplication notNil ifTrue:[
       
    98                 s nextPutLine:('Masterapplication: ' , lastApplication masterApplication class name).
       
    99             ].
       
   100         ].
       
   101         s cr.
       
   102         s nextPutLine:'Press:'.
       
   103         s nextPutLine:'    v to inspect view (V to browse)'.
       
   104         aView topView ~~ aView ifTrue:[
       
   105             s nextPutLine:'    t to inspect topView (T to browse)'.
       
   106         ].
       
   107         lastApplication notNil ifTrue:[
       
   108             s nextPutLine:'    a to inspect application (A to browse)'.
       
   109             lastApplication masterApplication notNil ifTrue:[
       
   110                 s nextPutLine:'    m to inspect masterApplication (M to browse)'.
       
   111             ].
       
   112         ].
       
   113         s nextPutAll:'    ESC or button to leave'.
       
   114     ]
       
   115 
       
   116     "
       
   117      self shownInformationOfViewUnderMouseUntilButtonIsPressed
       
   118     "
       
   119 ! !
       
   120 
       
   121 !FlyByWindowInformation methodsFor:'queries'!
       
   122 
       
   123 toolTipFollowsMouse
       
   124     ^ true
       
   125 ! !
       
   126 
       
   127 !FlyByWindowInformation methodsFor:'start & stop'!
       
   128 
       
   129 start
       
   130     |l|
       
   131 
       
   132     l := FlyByHelp currentHelpListener.
       
   133     l notNil ifTrue:[
       
   134         FlyByHelp stop.
       
   135         cleanupAction := [ FlyByHelp start ].
       
   136     ].
       
   137     finishSemaphore := Semaphore new.
       
   138     super start.
       
   139 !
       
   140 
       
   141 stop
       
   142     super stop.
       
   143     cleanupAction value.
       
   144     finishSemaphore notNil ifTrue:[
       
   145         finishSemaphore signalIf.
       
   146     ].
       
   147 !
       
   148 
       
   149 waitUntilFinished
       
   150     finishSemaphore wait.
       
   151 ! !
       
   152 
       
   153 !FlyByWindowInformation class methodsFor:'documentation'!
       
   154 
       
   155 version
       
   156     ^ '$Header$'
       
   157 ! !