FlyByWindowInformation.st
author Claus Gittinger <cg@exept.de>
Sun, 25 Oct 2009 02:20:25 +0200
changeset 2691 99bae4711b4d
parent 2587 81f38cd168a7
child 2699 22dd96b4e37f
permissions -rw-r--r--
*** empty log message ***

"
 COPYRIGHT (c) 2008 by eXept Software AG
              All Rights Reserved

 This software is furnished under a license and may be used
 only in accordance with the terms of that license and with the
 inclusion of the above copyright notice.   This software may not
 be provided or otherwise made available to, or used by, any
 other person.  No title to or ownership of the software is
 hereby transferred.
"
"{ Package: 'stx:libtool2' }"

FlyByHelp subclass:#FlyByWindowInformation
	instanceVariableNames:'lastApplication lastView cleanupAction finishSemaphore'
	classVariableNames:''
	poolDictionaries:''
	category:'Interface-Help'
!

!FlyByWindowInformation class methodsFor:'documentation'!

copyright
"
 COPYRIGHT (c) 2008 by eXept Software AG
              All Rights Reserved

 This software is furnished under a license and may be used
 only in accordance with the terms of that license and with the
 inclusion of the above copyright notice.   This software may not
 be provided or otherwise made available to, or used by, any
 other person.  No title to or ownership of the software is
 hereby transferred.
"
!

examples
"
    self shownInformationOfViewUnderMouseUntilButtonIsPressed
"
!

shownInformationOfViewUnderMouseUntilButtonIsPressed
    self start waitUntilFinished

    "
     self shownInformationOfViewUnderMouseUntilButtonIsPressed
    "
! !

!FlyByWindowInformation methodsFor:'accessing'!

cleanupAction:something
    cleanupAction := something.
!

lastApplication
    ^ lastApplication
!

lastView
    ^ lastView
! !

!FlyByWindowInformation methodsFor:'defaults'!

flyByHelpTimeoutMillis
    ^ 1000
! !

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

version_CVS
    ^ '$Header$'
! !