initial checkin
authorClaus Gittinger <cg@exept.de>
Tue, 26 Feb 2008 11:26:17 +0100
changeset 2300 afddc24415dc
parent 2299 fff41ffaaf26
child 2301 1fe99d697bbd
initial checkin
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$'
+! !