"

 COPYRIGHT (c) 2001 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:libview2' }"

"{ NameSpace: Smalltalk }"

ActiveHelp subclass:#FlyByHelp

	instanceVariableNames:'currentFrame currentView currentHelpView showProcess closeProcess'

	classVariableNames:'MaxNumberOfLines MaxNumberOfColumns'

	poolDictionaries:''

	category:'Interface-Help'

!

Query subclass:#HelpKeyInsteadOfHelpTextQuery

	instanceVariableNames:''

	classVariableNames:''

	poolDictionaries:''

	privateIn:FlyByHelp

!

!FlyByHelp class methodsFor:'documentation'!

copyright

"

 COPYRIGHT (c) 2001 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.

"

!

documentation

"

    an instance of me is used to provide tooltips 

    sigh: Smalltalk was ahead of its time in the early 90's:

        initially called 'activeHelp', 

        then renamed to 'flyByHelp' 

        and is now commonly known as 'tooltip'.

    I will watch the mouse movements via an event hook, and determine

    where the mouse pointer is. 

    Then ask the underlying view about its helpText 

    and display it in a little floating popup view.

    The tool is installed via:

        FlyByHelp start

    and possibly deactivated/uninstalled via:

        FlyByHelp stop

    There can be only one FlyByHelp at any time - the start/stop methods assure that.

    Additional features:

        if you press CTRL, the helpKey which was responsible for the helptext

        is shown instead of the full text. This helps to find out which text to modify

        in case of typing errors or missing translations.

        if you press LEFTSHIFT+RIGHTSHIFT+CTRL (in that order), a menu developper menu appears,

        but only if Smalltalk is in the debeloper mode (i.e. not in end-user applications).

"

!

examples

"

    UserPreferences current toolTipShapeStyle:nil

    UserPreferences current toolTipShapeStyle:#cartoon

     FlyByHelp isActive

     FlyByHelp stop

     FlyByHelp start

"

! !

!FlyByHelp class methodsFor:'accessing'!

currentlyShownView

    TheOneAndOnlyHelpListener isNil ifTrue:[^ nil].

    ^ TheOneAndOnlyHelpListener currentlyShownView

    "Modified: / 09-06-2010 / 16:35:48 / cg"

!

helpKeyInsteadOfHelpTextQuery

    ^ HelpKeyInsteadOfHelpTextQuery

    "Created: / 22-02-2019 / 09:38:18 / Claus Gittinger"

!

maxNumberOfColumns

    ^ MaxNumberOfColumns ? 200

!

maxNumberOfLines

    ^ MaxNumberOfLines ? 40

! !

!FlyByHelp methodsFor:'defaults'!

flyByHelpTimeoutMillis

    "abort flyby help text generation, if no text can be generated within that

     time delta. This is used to abort long-lasting parsing/scanning/analysis in

     large methods when the mouse is moved over some syntactic constructs, and

     it takes too long to parse...

     The returned time is given in ms"

    ^ 300

! !

!FlyByHelp methodsFor:'developer menu'!

openDeveloperMenuFor:aView at:aPoint

    "with CTRL+SHIFT, this menu appears"

    |app helpText helpKey|

    self hideHelp.

    app := aView topView application.

    app isNil ifTrue:[ Transcript showCR:'no app for view: %1' with:aView. ^ self ].

    app enqueueDelayedAction:[

        |editor m canDefineTranslationForLabel canDefineTranslationForHelpText menuItem i|

        canDefineTranslationForHelpText := lastHelpText notEmptyOrNil.

        canDefineTranslationForHelpText := canDefineTranslationForHelpText or:[ (helpText := aView helpTextAt:aPoint) notEmptyOrNil].

        canDefineTranslationForHelpText := canDefineTranslationForHelpText or:[ (helpText := aView helpText) notEmptyOrNil].

        canDefineTranslationForHelpText := canDefineTranslationForHelpText or:[ (helpKey := aView helpKey) notNil].

        canDefineTranslationForHelpText := canDefineTranslationForHelpText or:[ (helpText := app helpTextFor:aView) notEmptyOrNil ].

        m := Menu new.

        m addItem:(MenuItem 

        aView isMenu ifTrue:[

            menuItem := aView itemAtPoint:aPoint.

            menuItem notNil ifTrue:[

                m addItem:(MenuItem 

                    label:(('MenuItem''s NameKey: ',(menuItem nameKey printString)) withColor:Color grey)).

            ]. 

        ]. 

        m addSeparator. 

        m addItem:(MenuItem 

            label: 'Copy Helptext'

            itemValue:[

                |package key |

                key := (lastHelpText ? helpText ? helpKey) asString string.

                aView topView setClipboardText:key.

            ]

            enabled:canDefineTranslationForHelpText).

        m addSeparator.

        m addItem:(MenuItem 

            label: 'Edit Resources'

            itemValue:[ 

                app enqueueDelayedAction:[

                    app withWaitCursorDo:[

                        editor := Tools::InternationalLanguageTranslationEditor

                                        openOnPackage:((aView topView application ? aView) class package).

                        editor selectOrAddKey:(lastHelpText storeString withoutCRs).

                        Transcript showCR:'help text is: %1' with:lastHelpText storeString withoutCRs.

                    ].    

                ].    

            ]).

        m addItem:(MenuItem 

            label: 'Browse Resources'

            itemValue:[ 

                app enqueueDelayedAction:[

                    app withWaitCursorDo:[

                        FileBrowser default 

                            openOn:(app class projectDefinitionClass 

                                        packageDirectory / 'resources').

                    ].    

                ].    

            ]).

        canDefineTranslationForLabel := 

            [

                (aView isKindOf:Label) or:[aView respondsTo:#label]

            ].    

        m addItem:(MenuItem 

            label: 'Define Translation for Label...'

            itemValue:[

                |package key |

                key := aView label asString string.

                package := app class package.

                ResourcePack defineResourceFor:key package:package.

            ]

            enabled:canDefineTranslationForLabel).

        m addItem:(MenuItem 

            label: 'Define Translation for Helptext...'

            itemValue:[

                |package key |

                key := (lastHelpText ? helpText ? helpKey) asString string.

                package := app class package.

                ResourcePack defineResourceFor:key package:package.

            ]

            enabled:canDefineTranslationForHelpText).

        m addSeparator. 

        m addItem:(i := MenuItem 

            label: 'Browse Application'

            itemValue:[ SystemBrowser default openInClass:aView application class]).

        i enabled:(aView application notNil).

        m addItem:(i := MenuItem 

            label: 'UI Painter'

            itemValue:[ UIPainter openOnClass:aView application class andSelector:#windowSpec]).

        i enabled:(aView application notNil).

        aView application ~~ app ifTrue:[    

            m addSeparator. 

            m addItem:(MenuItem 

                label: 'Browse Top Application'

                itemValue:[ SystemBrowser default openInClass:app class]).

            m addItem:(MenuItem 

                label: 'UI Painter on Top Application'

                itemValue:[ UIPainter openOnClass:app class andSelector:#windowSpec]).

        ].

        m addSeparator. 

        m addItem:(i := MenuItem label: 'Inspect Application' itemValue:[ app inspect ]).

        i enabled:(app notNil).

        m addItem:(i := MenuItem label: 'Inspect View' itemValue:[ aView inspect ]).

        m addItem:(i := MenuItem label: 'Inspect Model' itemValue:[ aView model inspect ]).

        i enabled:(aView model notNil).

        menuItem notNil ifTrue:[

            m addItem:(MenuItem label: 'Inspect Menuitem' itemValue:[ menuItem inspect ]).

        ].

        m showAtPointer.

    ].

    "Created: / 22-02-2019 / 09:32:35 / Claus Gittinger"

    "Modified: / 21-07-2019 / 07:04:08 / Claus Gittinger"

! !

!FlyByHelp methodsFor:'event handling'!

buttonMotion:buttonAndModifierState x:x y:y view:aView

    "/ DebuggingEvents := true

    "/ DebuggingEvents := false

    DebuggingEvents == true ifTrue:[

        ('%1: ==== ButtonMotion view:%2' 

                bindWith:self className 

                with:aView) infoPrintCR.

    ].

    aView == currentHelpView ifTrue:[

        "/ the help-bubble itself

        ^ false

    ].

    "/ don't start tooltip, if this view is not active.

    "/ The following line does not work, because motion events are reported for the current focus-view,

    "/ which is always active. Must check after we have determined the view under the pointer

    "/      aView topView isActive ifFalse:[^ false].

    ^ super buttonMotion:buttonAndModifierState x:x y:y view:aView

    "Modified: / 28-06-2019 / 08:43:54 / Claus Gittinger"

!

buttonPress:button x:x y:y view:aView

    |prevView|

    "/ DebuggingEvents := true

    "/ DebuggingEvents := false

    DebuggingEvents == true ifTrue:[

        ('%1: ButtonPress view:%2' 

                bindWith:self className 

                with:aView) infoPrintCR.

    ].

    "/ hideHelp nils the currentView

    "/ we restore it, so the tooltip is not shown again for this view

    "/ until the mouse really leaves the view

    "/ let's call this the "do-not-show-in-this-view mode"

    prevView := currentView.

    self hideHelp.

    currentView := prevView.

    ^ false

    "Modified: / 23-12-2011 / 20:37:28 / cg"

    "Modified: / 28-06-2019 / 08:43:57 / Claus Gittinger"

!

keyPress:key x:x y:y view:aView

    "care for the special keys:

        Ctrl (while help is shown)

        L-Shift+R-Shift+Ctrl (while nothing is shown)

    "

    <resource: #keyboard (#Escape #Control #Shift)>

    |prevView text|

    "/ DebuggingEvents := true

    "/ DebuggingEvents := false

    "/ Debugging := true.

    "/ Debugging := false.

    DebuggingEvents == true ifTrue:[

        '-----' infoPrintCR.

        ('%1: KeyPress view:%2 (currentHelpView=%3)' 

                bindWith:self className 

                with:aView

                with:currentHelpView) infoPrintCR.

    ].

    currentHelpView notNil ifTrue:[

        "/ Transcript show:'with help view shown: '; showCR:key.

        key == #Escape ifTrue:[

            prevView := currentView.

            self hideHelp.

            currentView := prevView.

            ^ false

        ].

        (#(#'Control' #'Control_L' #'Control_R') includes:key) ifTrue:[

            "/ reopen showing the key

            "/ Transcript show:'re initialize help: '; showCR:key.

            self initiateHelpFor:aView at:(x@y) now:true.

            ^ false

        ].

        Smalltalk isStandAloneApp ifFalse:[

            key == $§ ifTrue:[

                "/ generate a line suitable for the resources file (a null translation)

                "/ into the clipboard; makes it easy to add missing translations to a .rs file,

                "/ by pressing paragraph whenever you see an untranslated helptext

                text := (lastHelpText storeString withoutCRs, '    ' , lastHelpText storeString withoutCRs).

                aView setClipboardText:text.

                self hideHelp.

                ^ false

            ].

            (#(#'Shift' #'Shift_L' #'Shift_R') includes:key) ifTrue:[

                aView device ctrlDown ifTrue:[

                    self openDeveloperMenuFor:aView at:x@y

                ].

                ^ false

            ].

        ].        

        (#('Shift' #'Shift_L' #'Shift_R' ) includes:key) ifTrue:[

            "/ do not close on those...

            ^ false

        ].

    ] ifFalse:[

        "/ Transcript show:'without help view shown: '; showCR:key.

        Smalltalk isStandAloneApp ifFalse:[

            "/ both shifts AND then ctrl...

            (#(#'Control' #'Control_L' #'Control_R') includes:key) ifTrue:[

                aView device leftShiftDown ifTrue:[

                    aView device rightShiftDown ifTrue:[

                        self openDeveloperMenuFor:aView at:x@y

                    ].

                ].

                ^ false

            ].

        ].    

    ].    

    "/ hideHelp nils the currentView

    "/ we restore it, so the tooltip is not shown again for this view

    "/ until the mouse really leaves the view

    "/ let's call this the "do-not-show-in-this-view mode"

    prevView := currentView.

    self hideHelpIgnoringErrors.

    currentView := prevView.

    ^ false

    "/ ^ super keyPress:key x:x y:y view:aView

    "Modified (format): / 25-12-2011 / 10:25:23 / cg"

    "Modified (format): / 16-04-2018 / 16:53:15 / stefan"

    "Modified: / 20-07-2019 / 08:55:01 / Claus Gittinger"

!

keyRelease:key x:x y:y view:aView

    <resource: #keyboard (#Control)>

    "/ DebuggingEvents := true

    "/ DebuggingEvents := false

    DebuggingEvents == true ifTrue:[

        ('%1: KeyRelease view:%2' 

                bindWith:self className 

                with:aView) infoPrintCR.

    ].

    currentHelpView notNil ifTrue:[

        (#(#'Control' #'Control_L' #'Control_R') includes:key) ifTrue:[

            "/ reopen showing the text

            self initiateHelpFor:aView at:(x@y) now:true.

            ^ true

        ].

        (#('Shift' #'Shift_L' #'Shift_R' #'Control' #'Control_L' #'Control_R') includes:key) ifTrue:[

            "/ do not close on those...

            ^ false

        ].

    ].

    ^ super keyRelease:key x:x y:y view:aView

    "Created: / 20-02-2019 / 11:26:19 / Claus Gittinger"

    "Modified: / 28-06-2019 / 08:44:06 / Claus Gittinger"

!

mouseWheelMotion:state x:x y:y amount:amount deltaTime:dTime view:aView

    "/ DebuggingEvents := true

    "/ DebuggingEvents := false

    DebuggingEvents == true ifTrue:[

        ('%1: MouseWheel view:%2' 

                bindWith:self className 

                with:aView) infoPrintCR.

    ].

    currentHelpView notNil ifTrue:[

        self handleMouseIn:aView x:x y:y.

    ].

    ^ false

    "Modified: / 28-06-2019 / 08:44:10 / Claus Gittinger"

!

pointerLeave:state view:aView

    "/ DebuggingEvents := true

    "/ DebuggingEvents := false

    DebuggingEvents == true ifTrue:[

        ('%1: **** PointerLeave view:%2' 

                bindWith:self className 

                with:aView) infoPrintCR.

    ].

    aView == currentHelpView ifTrue:[^ true].

    "/ clear the do-not-show-in-this-view mode (see keyPress)

"/     (currentHelpView isNil and:[currentView notNil]) ifTrue:[currentView := nil].

    ^ super pointerLeave:state view:aView

    "Modified: / 28-06-2019 / 08:44:13 / Claus Gittinger"

! !

!FlyByHelp methodsFor:'help texts'!

helpTextFromModel:aModel view:aView at:aPointOrNil 

    "helper: ask aModel for its helpText."

    |text|

    (aPointOrNil notNil and:[aModel respondsTo:#helpTextFor:at:]) ifTrue:[

        text := aModel helpTextFor:aView at:aPointOrNil.

        text notNil ifTrue:[

            "/ Transcript showCR:aModel.

            "/ Transcript showCR:'via model-text'; showCR:text.

            ^ text

        ].

    ].

    (aModel respondsTo:#helpTextFor:) ifTrue:[

        text := aModel helpTextFor:aView.

        text notNil ifTrue:[

            "/ Transcript showCR:aModel.

            "/ Transcript showCR:'via model-text'; showCR:text.

            ^ text

        ].

    ].

    ^ nil

    "Modified: / 09-01-2018 / 17:35:26 / stefan"

    "Modified: / 11-06-2018 / 09:53:40 / Claus Gittinger"

!