--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/FlyByWindowInformation.st Tue Feb 26 11:26:17 2008 +0100
@@ -0,0 +1,157 @@
+"{ Package: 'stx:libtool2' }"
+
+FlyByHelp subclass:#FlyByWindowInformation
+ instanceVariableNames:'lastApplication lastView cleanupAction finishSemaphore'
+ classVariableNames:''
+ poolDictionaries:''
+ category:'Interface-Help'
+!
+
+!FlyByWindowInformation class methodsFor:'documentation'!
+
+examples
+"
+ self shownInformationOfViewUnderMouseUntilButtonIsPressed
+"
+!
+
+shownInformationOfViewUnderMouseUntilButtonIsPressed
+ self start waitUntilFinished
+
+ "
+ self shownInformationOfViewUnderMouseUntilButtonIsPressed
+ "
+! !
+
+!FlyByWindowInformation methodsFor:'accessing'!
+
+cleanupAction:something
+ cleanupAction := something.
+!
+
+lastApplication
+ ^ lastApplication
+!
+
+lastView
+ ^ lastView
+! !
+
+!FlyByWindowInformation methodsFor:'event handling'!
+
+buttonMotion:state x:x y:y view:aView
+ super buttonMotion:state x:x y:y view:aView.
+ ^ true
+!
+
+buttonPress:button x:x y:y view:aView
+ self stop.
+ ^ true
+!
+
+keyPress:key x:x y:y view:aView
+ |obj action|
+
+ key == #Escape ifTrue:[
+ self stop.
+ ^ true
+ ].
+
+ key asLowercase == $a ifTrue:[
+ obj := lastApplication
+ ].
+ key asLowercase == $m ifTrue:[
+ obj := lastApplication masterApplication
+ ].
+ key asLowercase == $v ifTrue:[
+ obj := lastView
+ ].
+ key asLowercase == $t ifTrue:[
+ obj := lastView topView
+ ].
+ obj notNil ifTrue:[
+ key isLowercase ifTrue:[
+ action := [ obj inspect ].
+ ] ifFalse:[
+ action := [ obj browse ].
+ ].
+ action forkAt:8.
+ ].
+
+ ^ true
+! !
+
+!FlyByWindowInformation methodsFor:'help texts'!
+
+helpTextFor:aView at:aPointOrNil
+ lastView := aView.
+ lastApplication := aView application.
+
+ ^ String streamContents:[:s |
+ s nextPutLine:('View: ' , aView class name).
+ aView topView ~~ aView ifTrue:[
+ s nextPutLine:('Topview: ' , aView topView class name).
+ ].
+ lastApplication notNil ifTrue:[
+ s nextPutLine:('Application: ' , lastApplication class name).
+ lastApplication masterApplication notNil ifTrue:[
+ s nextPutLine:('Masterapplication: ' , lastApplication masterApplication class name).
+ ].
+ ].
+ s cr.
+ s nextPutLine:'Press:'.
+ s nextPutLine:' v to inspect view (V to browse)'.
+ aView topView ~~ aView ifTrue:[
+ s nextPutLine:' t to inspect topView (T to browse)'.
+ ].
+ lastApplication notNil ifTrue:[
+ s nextPutLine:' a to inspect application (A to browse)'.
+ lastApplication masterApplication notNil ifTrue:[
+ s nextPutLine:' m to inspect masterApplication (M to browse)'.
+ ].
+ ].
+ s nextPutAll:' ESC or button to leave'.
+ ]
+
+ "
+ self shownInformationOfViewUnderMouseUntilButtonIsPressed
+ "
+! !
+
+!FlyByWindowInformation methodsFor:'queries'!
+
+toolTipFollowsMouse
+ ^ true
+! !
+
+!FlyByWindowInformation methodsFor:'start & stop'!
+
+start
+ |l|
+
+ l := FlyByHelp currentHelpListener.
+ l notNil ifTrue:[
+ FlyByHelp stop.
+ cleanupAction := [ FlyByHelp start ].
+ ].
+ finishSemaphore := Semaphore new.
+ super start.
+!
+
+stop
+ super stop.
+ cleanupAction value.
+ finishSemaphore notNil ifTrue:[
+ finishSemaphore signalIf.
+ ].
+!
+
+waitUntilFinished
+ finishSemaphore wait.
+! !
+
+!FlyByWindowInformation class methodsFor:'documentation'!
+
+version
+ ^ '$Header$'
+! !