diff -r fff41ffaaf26 -r afddc24415dc FlyByWindowInformation.st --- /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$' +! !