#REFACTORING by cg
authorClaus Gittinger <cg@exept.de>
Fri, 22 Feb 2019 09:50:05 +0100
changeset 4231 5542e515b2d9
parent 4230 240c17007808
child 4232 a55135461bc3
#REFACTORING by cg class: FlyByHelp use a query to ask for the helpkey. added: #openDeveloperMenuFor:at: removed: #openDeveloperMenuFor: changed: #initiateHelpFor:at:now: #keyPress:x:y:view: class: FlyByHelp class added: #helpKeyInsteadOfHelpTextQuery class: FlyByHelp::HelpKeyInsteadOfHelpTextQuery class definition added: #defaultResumeValue class: FlyByHelp::HelpKeyInsteadOfHelpTextQuery class added: #documentation
FlyByHelp.st
--- a/FlyByHelp.st	Thu Feb 21 17:56:00 2019 +0100
+++ b/FlyByHelp.st	Fri Feb 22 09:50:05 2019 +0100
@@ -22,6 +22,13 @@
 	category:'Interface-Help'
 !
 
+Query subclass:#HelpKeyInsteadOfHelpTextQuery
+	instanceVariableNames:''
+	classVariableNames:''
+	poolDictionaries:''
+	privateIn:FlyByHelp
+!
+
 !FlyByHelp class methodsFor:'documentation'!
 
 copyright
@@ -80,6 +87,12 @@
     "Modified: / 09-06-2010 / 16:35:48 / cg"
 !
 
+helpKeyInsteadOfHelpTextQuery
+    ^ HelpKeyInsteadOfHelpTextQuery
+
+    "Created: / 22-02-2019 / 09:38:18 / Claus Gittinger"
+!
+
 maxNumberOfColumns
     ^ MaxNumberOfColumns ? 200
 !
@@ -156,7 +169,7 @@
         (#(#'Shift' #'Shift_L' #'Shift_R') includes:key) ifTrue:[
             aView device ctrlDown ifTrue:[
                 self hideHelp.
-                self openDeveloperMenuFor:aView
+                self openDeveloperMenuFor:aView at:x@y
             ].
             ^ false
         ].
@@ -186,7 +199,7 @@
 
     "Modified (format): / 25-12-2011 / 10:25:23 / cg"
     "Modified (format): / 16-04-2018 / 16:53:15 / stefan"
-    "Modified: / 21-02-2019 / 17:22:48 / Claus Gittinger"
+    "Modified: / 22-02-2019 / 09:32:28 / Claus Gittinger"
 !
 
 keyRelease:key x:x y:y view:aView
@@ -215,7 +228,7 @@
     ^ false
 !
 
-openDeveloperMenuFor:aView
+openDeveloperMenuFor:aView at:aPoint
     |app helpText helpKey|
     
     app := aView topView application.
@@ -250,8 +263,7 @@
 
         canDefineTranslationForLabel := 
             [
-                aView isTextLabel
-                or:[ aView isButton ]
+                (aView isKindOf:Label) or:[aView respondsTo:#label]
             ].    
 
         canDefineTranslationForHelpText := 
@@ -259,6 +271,7 @@
                 |ok|
 
                 ok := lastHelpText notEmptyOrNil.
+                ok := ok or:[ (helpText := aView helpTextAt:aPoint) notEmptyOrNil].
                 ok := ok or:[ (helpText := aView helpText) notEmptyOrNil].
                 ok := ok or:[ (helpKey := aView helpKey) notNil].
                 ok := ok or:[ (helpText := app helpTextFor:aView) notEmptyOrNil ].
@@ -289,7 +302,7 @@
         m showAtPointer.
     ].
 
-    "Created: / 21-02-2019 / 17:20:20 / Claus Gittinger"
+    "Created: / 22-02-2019 / 09:32:35 / Claus Gittinger"
 !
 
 pointerLeave:state view:aView
@@ -500,7 +513,9 @@
             ex suspendedContext fullPrintAllOn:Transcript.
             "/ self halt.
         ] do:[
-            text := self helpTextFor:aView at:aPointOrNil.
+            HelpKeyInsteadOfHelpTextQuery answer:(aView device ctrlDown) do:[
+                text := self helpTextFor:aView at:aPointOrNil.
+            ].
         ].
     ] valueWithWatchDog:[ 
         'FlyByhelp [info]: flyBy text generation took too long' infoPrintCR.
@@ -549,7 +564,7 @@
 
     "Modified: / 22-03-2011 / 19:10:28 / cg"
     "Modified: / 16-04-2018 / 12:20:33 / stefan"
-    "Modified: / 06-06-2018 / 17:19:26 / Claus Gittinger"
+    "Modified: / 22-02-2019 / 09:42:56 / Claus Gittinger"
 !
 
 showHelp:aHelpText for:view
@@ -693,6 +708,35 @@
     "Created: 28.6.1997 / 14:03:17 / cg"
 ! !
 
+!FlyByHelp::HelpKeyInsteadOfHelpTextQuery class methodsFor:'documentation'!
+
+documentation
+"
+    kludge to force application to return the helpKey instead of the
+    help text. 
+    Answering true will tell the ApplicationModel to return the key.
+    (see AppModel >> helpTextForKey:)
+
+    [author:]
+        Claus Gittinger
+
+    [instance variables:]
+
+    [class variables:]
+
+    [see also:]
+
+"
+! !
+
+!FlyByHelp::HelpKeyInsteadOfHelpTextQuery methodsFor:'defaults'!
+
+defaultResumeValue
+    ^ false
+
+    "Created: / 22-02-2019 / 09:48:28 / Claus Gittinger"
+! !
+
 !FlyByHelp class methodsFor:'documentation'!
 
 version