"{ 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:buttonAndModifierState x:x y:y view:aView
    super buttonMotion:buttonAndModifierState 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 lcKey|

    key == #Escape ifTrue:[
        self stop.
        ^ true
    ].

    key == $? ifTrue:[
        [
            WindowTreeView openOn:(lastView topView) initialSelection:lastView.
        ] fork.
        self stop.
        ^ true.
    ].

    key isCharacter ifTrue:[
        lcKey := key asLowercase.

        lcKey == $a ifTrue:[
            obj := lastApplication
        ].
        lcKey == $o ifTrue:[
            obj := lastView model
        ].
        lcKey == $m ifTrue:[
            obj := lastApplication masterApplication
        ].
        lcKey == $v ifTrue:[
            obj := lastView
        ].
        lcKey == $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 |
        |topViewToInspect applicationToInspect masterApplicationToInspect modelToInspect|

        aView topView ~~ aView ifTrue:[
            topViewToInspect := aView topView.
        ].
        lastApplication notNil ifTrue:[
            applicationToInspect := lastApplication.
            masterApplicationToInspect := lastApplication masterApplication.
        ].
        aView model notNil ifTrue:[
            modelToInspect := aView model.
            ((modelToInspect == applicationToInspect)
            or:[ modelToInspect == masterApplicationToInspect ]) ifTrue:[
                modelToInspect := nil.
            ].
        ].

        s nextPutLine:('View: ' , aView class name, ' "',aView name printString,'"').
        modelToInspect notNil ifTrue:[
            s nextPutLine:('Model: ' , modelToInspect class name).
        ].
        topViewToInspect notNil ifTrue:[
            s nextPutLine:('Topview: ' , topViewToInspect class name).
        ].
        applicationToInspect notNil ifTrue:[
            s nextPutLine:('Application: ' , applicationToInspect class name).
        ].
        masterApplicationToInspect notNil ifTrue:[
            s nextPutLine:('Masterapplication: ' , masterApplicationToInspect class name).
        ].

        s cr.
        s nextPutLine:'Press:'.
        s nextPutLine:'    ? to show the viewtree'.
        s nextPutLine:'    v to inspect view (V to browse)'.
        modelToInspect notNil ifTrue:[
            s nextPutLine:'    o to inspect model (O to browse)'.
        ].
        topViewToInspect notNil ifTrue:[
            s nextPutLine:'    t to inspect topView (T to browse)'.
        ].
        applicationToInspect notNil ifTrue:[
            s nextPutLine:'    a to inspect application (A to browse)'.
            masterApplicationToInspect notNil ifTrue:[
                s nextPutLine:'    m to inspect masterApplication (M to browse)'.
            ].
        ].
        s nextPutAll:'ESC or button to leave flyBy-info mode.'.
    ]

    "
     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$'
! !