#OTHER by cg
fix: if moving over an item within the same view,
possibly suppress already forked and scheduled helptext
(eg. when moving over close-icon in a tabList, moving within the same
tab label, but away from the close icon, the tooltip was shown
erronously in the previous version)
"
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
helpTextProcess developerMenuShown'
classVariableNames:'MaxNumberOfColumns MaxNumberOfLines'
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"
^ 100
! !
!FlyByHelp methodsFor:'developer menu'!
openDeveloperMenuFor:aView at:aPoint
"with CTRL+SHIFT, this menu appears"
|topView app helpText helpKey|
self hideHelp.
topView := aView topView.
app := topView application.
app isNil ifTrue:[
Transcript showCR:'no app for view: %1' with:aView.
"/ ^ self
].
developerMenuShown == true ifTrue:[
topView windowGroup process interruptWith:[AbortOperationRequest raise].
developerMenuShown := false.
].
topView sensor
pushAction:
"/ app enqueueDelayedAction:
[
|editor m canDefineTranslationForLabel canDefineTranslationForHelpText
pointInMenu menuItem i viewsApp classBrowser|
classBrowser := SystemBrowser default.
viewsApp := aView application. "/ could be different from top-app (if embedded)
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:[ app notNil and:[(helpText := app helpTextFor:aView) notEmptyOrNil] ].
m := Menu new.
m addItem:(MenuItem
label:(((aView fullXPath ? 'unnamed') contractTo:120) allGray)).
aView isMenu ifTrue:[
Transcript showCR:'view %1 @ %2' with:aView with:aPoint.
menuItem := aView grabMenuItemAtPoint:aPoint.
menuItem notNil ifTrue:[
m addItem:(MenuItem
label:(('MenuItem''s NameKey: ',(menuItem nameKey printString)) allGray)).
m addItem:(MenuItem
label:(('MenuItem''s Value: ',(menuItem itemValue printString contractTo:40)) allGray)).
(app notNil
and:[menuItem itemValue isSymbol
and:[app respondsTo:menuItem itemValue]]
) ifTrue:[
m addItem:(MenuItem
label:('Browse MenuItem''s Action')
itemValue:[ classBrowser openInClass:app class theNonMetaclass selector:menuItem itemValue]).
].
].
].
m addSeparator.
m addItem:(MenuItem
label: 'Copy Helptext'
itemValue:[
|package key |
key := (lastHelpText ? helpText ? helpKey) asString string.
topView setClipboardText:key.
]
enabled:canDefineTranslationForHelpText).
m addSeparator.
m addItem:(MenuItem
label: ('Edit Resources (of %1)' bindWith:((app ? aView) class package))
itemValue:[
app enqueueDelayedAction:[
app withWaitCursorDo:[
editor := Tools::InternationalLanguageTranslationEditor
openOnPackage:((app ? 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 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).
(viewsApp ? app) notNil ifTrue:[
m addSeparator.
m addItem:(i := MenuItem
label:('Browse Application (%1)' bindWith:(viewsApp ? app) className)
itemValue:[ classBrowser openInClass:(viewsApp ? app) class]).
i enabled:((viewsApp ? app) notNil).
m addItem:(i := MenuItem
label: 'Browse Application''s helpSpec'
itemValue:[ classBrowser openInClass:(viewsApp ? app) class theMetaclass selector:#helpSpec]).
i enabled:((viewsApp ? app) notNil and:[(viewsApp ? app) class theMetaclass includesSelector:#helpSpec]).
m addItem:(i := MenuItem
label: 'UI Painter'
itemValue:[ UIPainter openOnClass:(viewsApp ? app) class andSelector:#windowSpec]).
i enabled:((viewsApp ? app) notNil).
viewsApp ~~ app ifTrue:[
m addSeparator.
m addItem:(MenuItem
label:('Browse Top Application (%1)' bindWith:app className)
itemValue:[ classBrowser 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 (%1)' bindWith:aView className) itemValue:[ aView inspect ]).
m addItem:(i := MenuItem label:('Inspect Model (%1)' bindWith:aView model className) itemValue:[ aView model inspect ]).
i enabled:(aView model notNil).
menuItem notNil ifTrue:[
m addItem:(MenuItem label: 'Inspect Menuitem' itemValue:[ menuItem inspect ]).
].
m addSeparator.
m addItem:(i := MenuItem label:('Open ViewTree ') itemValue:[ Tools::ViewTreeInspectorApplication openOn:aView ]).
"/ does not work, because menuPanel showAtPointer does not give us the menu
"/ currentDeveloperMenu := m.
developerMenuShown := true.
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
(Suspended ? false) ifTrue:[^ false].
"/ 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 focusView debuggedView viewsDevice wg|
"/ DebuggingEvents := true
"/ DebuggingEvents := false
"/ Debugging := true.
"/ Debugging := false.
DebuggingEvents == true ifTrue:[
'-----' infoPrintCR.
('%1: KeyPress key:%2 view:%3 (currentHelpView=%4)'
bindWith:self className
with:key
with:aView
with:currentHelpView) infoPrintCR.
].
"/ key == #Help ifTrue:[
"/ Error handle:[:ex |
"/ DebuggingEvents == true ifTrue:[
"/ ex description infoPrintCR.
"/ ]
"/ ] do:[
"/ DebuggingEvents == true ifTrue:[
"/ 'open help...' infoPrintCR.
"/ ].
"/ aView openDocumentation.
"/ ^ false
"/ ].
"/ ].
viewsDevice := aView graphicsDevice.
wg := aView windowGroup.
(wg notNil and:[(focusView := wg focusView) notNil and:[focusView isMenu]]) ifTrue:[
debuggedView := focusView
] ifFalse:[
debuggedView := nil.
].
"/ Transcript showCR:aView.
(aView isKindOf:NoteBookView) ifTrue:[
debuggedView := aView
].
(viewsDevice leftShiftDown and:[viewsDevice rightShiftDown]) ifTrue:[
debuggedView := aView
].
(currentHelpView notNil
or:[aView isMenu
or:[debuggedView notNil
]]) ifTrue:[
Smalltalk isStandAloneApp ifFalse:[
(#(#'Control' #'Control_L' #'Control_R' #'Ctrl' #'Ctrl_L' #'Ctrl_R') includes:key) ifTrue:[
"/ viewsDevice ctrlDown infoPrintCR.
viewsDevice shiftDown ifTrue:[
self openDeveloperMenuFor:(debuggedView ? aView) at:x@y.
^ false
].
"/ reopen showing the key
DebuggingEvents == true ifTrue:[
('================================================') infoPrintCR.
('re initialize help: ',key storeString) infoPrintCR.
].
self initiateHelpFor:aView at:(x@y) now:true.
^ false
].
(#(#'Shift' #'Shift_L' #'Shift_R') includes:key) ifTrue:[
viewsDevice ctrlDown ifTrue:[
self openDeveloperMenuFor:(debuggedView ? aView) at:x@y
].
^ false
].
].
].
currentHelpView notNil ifTrue:[
"/ Transcript show:'with help view shown: '; showCR:key.
key == #Escape ifTrue:[
prevView := currentView.
self hideHelp.
currentView := prevView.
^ false
].
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:[
"/ do not close on those...
^ 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"
"Modified: / 06-12-2019 / 11:46:36 / Stefan Vogel"
!
keyRelease:key x:x y:y view:aView
<resource: #keyboard (#Control)>
"/ DebuggingEvents := true
"/ DebuggingEvents := false
DebuggingEvents == true ifTrue:[
('%1: KeyRelease key:%2 view:%3 current:%4'
bindWith:self className
with:key storeString
with:aView
with:currentHelpView) infoPrintCR.
].
currentHelpView notNil ifTrue:[
(#(#'Control' #'Control_L' #'Control_R' #'Ctrl' #'Ctrl_L' #'Ctrl_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
(Suspended ? false) ifTrue:[^ false].
"/ 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
(Suspended ? false) ifTrue:[^ false].
"/ 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"
!
helpTextFromView:aView at:aPointOrNil
"helper: ask aView for its helpText."
|text key app|
"/ is there any view which does not understand helpTextAt: ???
(aPointOrNil notNil and:[aView respondsTo:#helpTextAt:]) ifTrue:[
text := aView helpTextAt:aPointOrNil.
text notNil ifTrue:[
"/ Transcript showCR:'via helpTextAt:'; showCR:text.
^ text
].
].
"/ is there any view which does not understand helpText ???
(aView respondsTo:#helpText) ifTrue:[
text := aView helpText.
text notNil ifTrue:[
"/ Transcript showCR:'via helpText'; showCR:text.
^ text value
].
].
"/ to be enabled in next release...
"/ (aView superView notNil
"/ and:[aView superView respondsTo:#helpTextFor:]) ifTrue:[
"/ text := aView superView helpTextFor:aView.
"/ text notNil ifTrue:[^ text].
"/ ].
"/ is there any view which does not understand helpKey ???
(aView respondsTo:#helpKey) ifTrue:[
key := aView helpKey.
key notNil ifTrue:[
app := aView application.
app isNil ifTrue:[
|topView topViewsHelpSpec|
"/ special case for oldStyle Dialog subclasses.
topView := aView topView.
(topViewsHelpSpec := topView helpSpec) notNil ifTrue:[
text := topViewsHelpSpec at:key ifAbsent:nil.
text notNil ifTrue:[
"/ Transcript showCR:'via topViewspec+helpKey'; showCR:text.
^ topView resources stringWithCRs:text.
].
].
app := Error handle:[:ex | nil] do:[ aView windowGroup mainGroup application ].
].
app notNil ifTrue:[
text := app helpTextForKey:key.
true "text notNil" ifTrue:[
"/ Transcript showCR:'via helpKey+helpTextForKey:'; showCR:text.
^ text
].
].
text := aView resources string:key.
true "(text notNil and:[text ~= key])" ifTrue:[
"/ Transcript showCR:'via helpKey'; showCR:text.
^ text
]
].
].
^ nil.
"Modified: / 09-01-2018 / 17:38:42 / stefan"
"Modified (format): / 07-06-2018 / 09:51:41 / sr"
"Modified: / 07-02-2019 / 19:18:39 / Claus Gittinger"
! !
!FlyByHelp methodsFor:'queries'!
currentlyShownView
^ currentHelpView
!
toolTipFollowsMouse
"if true, the tooltip-window moves with the pointer
so that it stays away from (does not cover) the mouse pointer"
^ false
"Modified: / 06-06-2018 / 17:37:19 / Claus Gittinger"
! !
!FlyByHelp methodsFor:'show & hide help'!
activeHelpViewForApplication:applicationOrNil text:helpText onDevice:aDevice
applicationOrNil notNil ifTrue:[
^ applicationOrNil activeHelpViewFor:helpText onDevice:aDevice
].
^ ActiveHelpView for:helpText onDevice:aDevice.
"
(ActiveHelpView for:'Hello' onDevice:Display) open
"
!
hideHelp
"hide the help text"
|p v|
"/ thisContext fullPrintAll.
"/ lastHelpText := nil.
self stopHelpDisplayProcess.
lastHelpText := nil.
currentHelpView notNil ifTrue:[
[
(v := currentHelpView) notNil ifTrue:[
currentHelpView := nil.
v destroy.
currentView := nil.
]
] valueUninterruptably
].
currentFrame := nil.
(p := closeProcess) notNil ifTrue:[
closeProcess := nil.
p terminate.
]
"Modified: / 28-06-1997 / 14:03:50 / cg"
"Modified: / 16-04-2018 / 16:51:01 / stefan"
"Modified: / 20-07-2019 / 08:48:34 / Claus Gittinger"
!
hideIfPointerLeft:aView
"hide help, if the pointer is not in aView"
|helpFrame whereOnScreen|
(helpFrame := currentFrame) notNil ifTrue:[
whereOnScreen := aView graphicsDevice pointerPosition.
((helpFrame insetBy:1@1) containsPoint:whereOnScreen) ifFalse:[
self hideHelp.
] ifTrue:[
pointerPositionAtShowTime notNil ifTrue:[
(whereOnScreen dist:pointerPositionAtShowTime) > 10 ifTrue:[
self hideHelp.
].
].
].
].
"Modified: / 28-05-1996 / 20:18:28 / cg"
"Modified: / 16-04-2018 / 16:59:48 / stefan"
"Modified: / 08-06-2018 / 10:30:04 / Claus Gittinger"
!
initiateHelpFor:aView at:aPointOrNil now:showItNow
"ask aView for helpText, passing x/y coordinates;
start a timeout process to display this helpText after some delay;
Normally used internally, but can also be used by widgets to force
re-negotiation of the displayed helpText
(for example in a menu, when the selection changes)"
|text delayTime|
(Suspended ? false) ifTrue:[^ false].
(suspended ? false) ifTrue:[^ self].
"/ Timestamp now infoPrint. ' initiate ' infoPrint. aView infoPrint. ' ' infoPrint. aPointOrNil infoPrintCR.
Debugging ifTrue:[
('%1: initiateHelpFor:at:now: %2' bindWith:self className with:aView) infoPrintCR.
].
(self interestedIn:aView) ifFalse:[
Debugging ifTrue:[
('%1: not interested' bindWith:self class name) infoPrintCR
].
"/ showProcess notNil ifTrue:[self halt].
"/ Timestamp now infoPrint. ' hide1 ' infoPrint. aPointOrNil infoPrintCR.
self hideHelp.
^ self
].
"/ do not allow for more than 200 ms to be spent in the
"/ helpText gatherer (the codeView parses the code for the variable under the cursor)
[
Error handle:[:ex |
('%1: [warning]: error while asking for helpText: %2' bindWith:self class name with:ex description) errorPrintCR.
'-------------------------' errorPrintCR.
ex suspendedContext fullPrintAllOn:(Transcript ? Stderr).
"/ self halt.
] do:[
HelpKeyInsteadOfHelpTextQuery answer:(aView device ctrlDown) do:[
text := self helpTextFor:aView at:aPointOrNil.
].
].
] valueWithWatchDog:[
('%1 [info]: flyBy text generation took too long' bindWith:self class name) infoPrintCR.
self hideHelp.
^ self
] afterMilliseconds:(self flyByHelpTimeoutMillis).
false ifTrue:[
(text notNil and:[text isEmpty]) ifTrue:[
Logger warning:('empty help from: ',aView class printString)
] ifFalse:[
text isEmptyOrNil ifTrue:[
Logger warning:('no help from: ',aView class printString)
].
].
].
(lastHelpText = text and:[lastHelpWidget == aView]) ifTrue:[
"/ Debugging := true
Debugging == true ifTrue:[
'same text: ' infoPrint. text infoPrintCR.
].
self toolTipFollowsMouse ifFalse:[
Debugging == true ifTrue:[
'tooltip does not follow mouse: ' infoPrint. text infoPrintCR.
].
"/ Timestamp now infoPrint. ' same; keep ' infoPrint. aPointOrNil infoPrintCR.
^ self
]
].
showProcess notNil ifTrue:[
self stopHelpDisplayProcess.
].
"/ Timestamp now infoPrint. ' hide2 ' infoPrint. aPointOrNil infoPrintCR.
self hideHelp.
((text size > 0) or:[text notNil and:[text isString not]]) ifTrue:[
self stopHelpDisplayProcess.
"/ Timestamp now infoPrint. ' hide3 ' infoPrint. aPointOrNil infoPrintCR.
self hideHelp.
(showItNow not and:[(delayTime := self delayTime) > 0]) ifTrue:[
"/ Timestamp now infoPrint. ' start ' infoPrint. aPointOrNil infoPrintCR.
showProcess :=
[
Delay waitForSeconds:delayTime.
[
aView device notNil ifTrue:[
aView device anyButtonPressed ifFalse:[
showProcess := nil.
self showHelp:text for:aView
]
].
] ensure:[
showProcess := nil.
]
] forkAt:(Processor userSchedulingPriority + 1).
] ifFalse:[
self showHelp:text for:aView
]
] ifFalse:[
Debugging == true ifTrue:[
'empty text: ' infoPrint. text infoPrintCR.
].
"/ Timestamp now infoPrint. ' hide4 ' infoPrint. aPointOrNil infoPrintCR.
self hideHelp
].
"Modified: / 22-03-2011 / 19:10:28 / cg"
"Modified: / 16-04-2018 / 12:20:33 / stefan"
"Modified: / 28-06-2019 / 08:44:00 / Claus Gittinger"
!
showHelp:aHelpText for:view
"show the help text for aView"
|wg applicationOrNil org p v device helpTextShown textLines
helpViewWidth helpViewHeight usableWidth monitorBounds usableHeight
showTime cursorView pos pointerPosition|
"/ thisContext fullPrintAllOn:Transcript.
(wg := view windowGroup) notNil ifTrue:[
wg isInModalLoop ifTrue:[
wg isModal ifFalse:[
Debugging ifTrue:[ 'FlyByHelp: not modal' infoPrintCR ].
^ self
].
].
].
device := view graphicsDevice.
pointerPosition := device pointerPosition.
"/ mouse still over that view?
cursorView := device viewFromPoint:pointerPosition.
cursorView ~~ view ifTrue:[
Debugging ifTrue:[ 'FlyByHelp: mouse no longer in view' infoPrintCR ].
^ self
].
(view == currentView and:[lastHelpText = aHelpText]) ifTrue:[
Debugging ifTrue:[ 'FlyByHelp: same text and widget' infoPrintCR ].
^ self
].
pointerPositionAtShowTime := pointerPosition.
lastHelpWidget := view.
lastHelpText := aHelpText.
helpTextShown := aHelpText.
"/ the text originator must already have generated CRs;
"/ no longer done here (otherwise, we could not generate tooltips with Windows filenames in it)
textLines := helpTextShown isStringCollection
ifTrue:[helpTextShown]
ifFalse:[
helpTextShown isString
ifTrue:[helpTextShown asCollectionOfLines asStringCollection]
ifFalse:[nil]].
textLines notNil ifTrue:[
textLines size > (self class maxNumberOfLines) ifTrue:[
textLines := (textLines copyTo:(self class maxNumberOfLines)) copyWith:'...'
].
textLines := textLines collect:[:l | l contractAtEndTo:(self class maxNumberOfColumns)].
helpTextShown := textLines asString.
].
(p := closeProcess) notNil ifTrue:[
closeProcess := nil.
p terminate.
].
currentHelpView notNil ifTrue:[
self hideHelp
].
"/ Transcript showCR:helpTextShown storeString.
helpTextShown isEmptyOrNil ifTrue:[^ self].
org := view originRelativeTo:nil.
currentFrame := org extent:view extent.
org := org + (view extent // 2).
wg notNil ifTrue:[ applicationOrNil := wg application ].
v := self activeHelpViewForApplication:applicationOrNil text:helpTextShown onDevice:device.
v perform:#controllingHelpListener: with:self ifNotUnderstood:[].
helpViewWidth := v width.
helpViewHeight := v height.
"https://expeccoalm.exept.de/D226383: keep the help window away from the pointer under any circumstances
(especially when the window touches the bottom or the right edge of the screen).
When the pointer is no longer in the current window, the help window is closed!!"
pos := device pointerPosition.
org := pos + (10@18).
monitorBounds := device monitorBoundsAt:org.
usableWidth := monitorBounds width - 2.
usableHeight := device usableHeightAt:org.
helpViewWidth > usableWidth ifTrue:[v width:(helpViewWidth := usableWidth)].
helpViewHeight > usableHeight ifTrue:[v height:(helpViewHeight := usableHeight)].
(org x + helpViewWidth) > (monitorBounds left + usableWidth) ifTrue:[
org x:(monitorBounds left + usableWidth - helpViewWidth).
].
(org y + helpViewHeight) > (monitorBounds top + usableHeight) ifTrue:[
org y:(monitorBounds top + usableHeight - helpViewHeight).
].
((org extent:v extent) containsPoint:pos) ifTrue:[
"pointer would be in the help window (see comment above).
Help window is at the lower right edge. Move it to the left of the pointer"
org x:(pos x - helpViewWidth - 20).
].
v origin:org.
v realize.
currentHelpView := v.
currentView := view.
showTime := self showTime.
(showTime > 0) ifTrue:[
"/ Transcript showCR:showTime.
p :=
[
[
Delay waitForSeconds:showTime.
[
|v|
(v := currentHelpView) notNil ifTrue:[
currentHelpView := nil.
v destroy.
]
] valueUninterruptably
] ifCurtailed:[
(p == closeProcess) ifTrue:[ closeProcess := nil ].
].
] newProcess.
p priority:(Processor userSchedulingPriority + 1).
closeProcess := p.
p resume.
].
"Modified: / 31-08-1995 / 19:20:45 / claus"
"Modified: / 06-06-2017 / 15:06:41 / cg"
"Modified (format): / 16-04-2018 / 17:29:10 / stefan"
"Modified: / 08-06-2018 / 10:28:32 / Claus Gittinger"
"Modified (format): / 14-06-2018 / 08:29:43 / Claus Gittinger"
!
stopHelpDisplayProcess
|p|
(p := showProcess) notNil ifTrue:[
showProcess := nil.
p terminate.
"/ Timestamp now infoPrint. ' stop' infoPrintCR.
].
"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
^ '$Header$'
!
version_CVS
^ '$Header$'
! !