From VisualWorks®, 7.6 of February 8, 2008 on March 3, 2008 at 9:41:47 pm (Dialog confirm: 'You are filing-in a Parcel source file!\\While this is possible it will not have\the same effect as loading the parcel.\None of the Parcel''s prerequisites will\be loaded and none of its load actions\will be performed.\\Are you sure you want to file-in?' withCRs) ifFalse: [self error: 'Parcel file-in abandoned. Choose terminate or close.'] <class> <name>HelpInterrupted</name> <environment>UI</environment> <super>UI.VisualPartAnnouncement</super> <private>false</private> none <imports></imports> <category>Interface-Announcements</category> <attributes> <package>Tools-HoverHelp</package> </attributes> </class> <comment> UI.HelpInterrupted
I am announced when the HoverHelp system detects any mouse click which should interrupt a help armed state or cancel a currently open HoverHelpWindow.
</comment> <class> <name>HoverHelpWindow</name> <environment>UI</environment> <super>UI.TransientWindow</super> <private>false</private> none current targetView lastCloseTime <imports></imports> <category>Tools-HoverHelp</category> <attributes> <package>Tools-HoverHelp</package> </attributes> </class> <comment> UI.HoverHelpWindow
HoverHelpWindow implements a singleton reusable instance of a hover help window. We keep track of the latest hover help window close time so that the TooltipAssistant can avoid the initial delay to open its tooltip when tooltips for other widgets have already opened. Under normal mouse movement, this would include such things as neighboring toolbar widgets or overlays on list items. It does not hurt that with very fast mouse movement this delay avoidance will apply to all hover help popups within the application window. HoverHelp consumers that implement a delay before the help window initially opens, must install the view using reserveFor: as soon as the state machine enters its delay. Otherwise we will are unable to interrupt the state machine delay and hover help windows can pop up and steal focus from the current window. Class Instance Variables: current <HoverHelpWindow> the singleton window targetView <View> the view associated with the currently open hover help window lastCloseTime <Time> the time in milliseconds when the last hover help window was recycled (closed), or nil
</comment> <class> <name>HoverHelpAssistant</name> <environment>UI</environment> <super>Core.Object</super> <private>false</private> none view stateMachine <imports></imports> <category>Tools-HoverHelp</category> <attributes> <package>Tools-HoverHelp</package> </attributes> </class> <comment> UI.HoverHelpAssistant
HoverHelpAssistant is the abstract superclass for hover help suppliers. Subclasses must implement the following messages: initialize-release initialize Instance Variables: view <VisualPart> the view with which the hover help content is associated
</comment> <class> <name>HoverHelpSensor</name> <environment>UI</environment> <super>UI.EventSensor</super> <private>false</private> none <imports></imports> <category>Tools-HoverHelp</category> <attributes> <package>Tools-HoverHelp</package> </attributes> </class> <comment> UI.HoverHelpSensor
HoverHelpSensor detects certain keyboard events which must be passed to the parent window.
</comment> <class> <name>TooltipAssistant</name> <environment>UI</environment> <super>UI.HoverHelpAssistant</super> <private>false</private> none tooltip <imports></imports> <category>Tools-HoverHelp</category> <attributes> <package>Tools-HoverHelp</package> </attributes> </class> <comment> UI.TooltipAssistant
TooltipAssistant implements a standard hover help window for a View. The stateMachine for this assistant consists of three states: cold - not hovering over a view, or not displaying tooltip content armed - hovering over a view which can display tooltip content reaper - displaying the tooltip content There are four asynchronous inputs which may drive changes from one state to the next: FrameEntered - An Announcement we get from our view when it becomes the currentMouseConsumer FrameExited - An Announcement we get from our view when it ceases to be the currentMouseConsumer HelpInterrupted - An Announcement we synthesize when we get any kind of UI interaction that indicates we're not just sitting around reading tooltips <timeout> - This is not an announcement, but some of the states have actions that occur after a delay if nothing else happens. We move to the "armed" state when the mouse enters a view that has a tooltip to display. If we linger in that state for longer than 800 ms, the tooltip opens and we enter the "reaper" state wherein there is an open tooltip. We return to the "cold" state and remove the tooltip after a five second delay or when the mouse leaves the view. Instance Variables: tooltip <BlockClosure | CharacterArray | UndefinedObject, VisualComponent> basically this is nil OR any object that responds to asTooltipGraphicFor:. See implementors of said message. If tooltip is a BlockClosure, it must be a single argument block which receives the associated View.
</comment> <methods> UI.HoverHelpWindow <category>private</category>
sensorClass ^HoverHelpSensor
tooltipDisplayBox "Preferentially align the left edge of the help window with the current mouse location and the top edge with the bottom of the mouse pointer box. Make sure the result fits the screen!" | mouse extent origin | mouse := self sensor state mousePoint. extent := component preferredBounds extent. origin := mouse + (0 @ 18). origin y > Screen default bounds bottom ifTrue: [origin := mouse - (0 @ (2 + extent y))]. ^Screen default makeRectangleVisible: (origin extent: extent)
</methods> <methods> UI.HoverHelpWindow <category>testing</category>
canProcessEvent ^false
isInvalid ^component isNil or: [handle isNil]
</methods> <methods> UI.HoverHelpWindow <category>accessing</category>
label ^(#HoverHelp << #dialogs >> 'HoverHelp')
targetController "Answer the controller of the window whose widget I am serving, or nil if it cannot be determined." ^self class targetView ifNotNil: [ :target | target controller ]
targetView "Answer the widget I am serving, or nil if it cannot be determined." ^self class targetView
targetWindowSensor "Answer the sensor of the window whose widget I am serving, or nil if it cannot be determined." ^ self targetController ifNotNil: [ :target | target sensor windowSensor ]
</methods> <methods> UI.HoverHelpWindow <category>events</category>
windowEventDispatcher ^self
</methods> <methods> UI.HoverHelpWindow <category>initialize-release</category>
recycle component ifNotNil: [ self releaseComponent ]. mapped ifTrue: [ handle ifNotNil: [ self unmap ] ]. self unscheduleWindow.
</methods> <methods> UI.HoverHelpWindow <category>opening/closing</category>
open self map; scheduleWindow; display.
openTooltip: aVisualGraphic component ifNotNil: [ :part | part invalidateNow ]. self component: (CompositePart new add: aVisualGraphic in: (0@0 corner: 1@1)); displayBox: self tooltipDisplayBox. component bounds: self bounds. self open.
</methods> <methods> UI.HoverHelpWindow class <category>instance creation</category>
current (current isNil or: [ current isInvalid ]) ifTrue: [ current := self newIn: (0@0 extent: 1@1) withType: #popUp ]. ^ current
</methods> <methods> UI.HoverHelpWindow class <category>accessing</category>
targetView ^ targetView.
</methods> <methods> UI.HoverHelpWindow class <category>testing</category>
isCloseRecent ^ lastCloseTime ifNil: [ false ] ifNotNil: [ Time millisecondClockValue - lastCloseTime < 800 ].
</methods> <methods> UI.HoverHelpWindow class <category>initialize-release</category>
recycle "self recycle" current ifNotNil: [ :fb | fb recycle ]. "Give focus back to the targetView's window, if it is still open, when this one closes." targetView ifNotNil: [ targetView topComponent ifNotNil: [ :win | win isOpen ifTrue: [ win becomeActive ] ]. targetView := nil ].
reset "self reset" self recycle. lastCloseTime := nil. current := nil.
</methods> <methods> UI.HoverHelpWindow class <category>opening/closing</category>
closeFor: anObject targetView == anObject ifTrue: [self recycle. lastCloseTime := Time millisecondClockValue].
openTooltip: aTooltipGraphic for: requestingView "Open a tooltip with location relative to the current mouse position." targetView := requestingView. ^ self current openTooltip: aTooltipGraphic.
reserveFor: anObject "As soon as a state machine is active, ie. waiting for its delay timeout, even though the hover help window is not yet open, remember a potential HoverHelp consumer so its state machine can be interrupted." targetView := anObject.
unreserve "A state machine is no longer waiting for its delay timeout, and we will not need to interrupt it." targetView := nil.
</methods> <methods> UI.HoverHelpWindow class <category>announcements</category>
noticeInterruptEvent "Interrupt any active or pending help activity." targetView ifNotNil: [ :target | target announceHelpInterrupted ].
noticeMouseMoved: aPoint "The mouse has changed position. Check if we should terminate any active or pending help activity." self targetView ifNotNil: [ :aView | (aView containsPoint: aPoint) ifFalse: [ aView announceHelpInterrupted ] ].
</methods> <methods> UI.HoverHelpAssistant <category>private</category>
buildStateMachine "Establish the states and the required action block for each subscribed anouncement that requires a state transition." ^self subclassResponsibility
log: aString "A handy little tool to debug state switches. All the key state transition methods throughout the class are instrumented to print an event log. Because that log is the easiest - if not the only - way to debug state transitions, if you don't need it, it is wiser to make this method a no-op rather than remove the instrumentation. Writing to the Transcript can fail at early stages of image startup, so the method has to protect against that." "[Transcript space; show: aString printString] on: Error do: [:ex | ex return]"
subscriptions "Answer a collection of Announcement subclasses to which the assistant must subscribe on behalf of the VisualPart. Each subclass must override this method to provide the subscriptions required by its own part. Some assistants may manage subscriptions only on behalf of other components, in which case this collection may simply be nil." ^ nil.
uninstall view tooltip: nil. stateMachine := nil.
</methods> <methods> UI.HoverHelpAssistant <category>initialize-release</category>
initialize self buildStateMachine.
onView: aView view := aView. self subscriptions ifNotNil: [:subs | stateMachine subscribeTo: subs from: view].
release view unsubscribe: stateMachine. stateMachine release. super release.
</methods> <methods> UI.HoverHelpAssistant class <category>instance creation</category>
new ^super new initialize
on: aView ^self new onView: aView
</methods> <methods> UI.HoverHelpSensor <category>event processing</category>
eventButtonPress: event "Mac requires this event to be explicitly redirected to the main window. On other platforms mouse clicks are redirected by the VM but doing it explicitly does no harm." [ self targetWindowSensor ifNotNil: [ :targetSensor | targetSensor eventButtonPress: event ] ] on: Error do: [ Transcript cr; show: 'HoverHelpSensor>>eventButtonPress:'; flush ].
eventKeyPress: event "All keyboard events should go to the window I am serving so the user typing while the help popup is open is not lost." [ self targetWindowSensor ifNotNil: [ :targetSensor | targetSensor eventKeyPress: event ] ] on: Error do: [ Transcript cr; show: 'HoverHelpSensor>>eventKeyPress:'; flush ].
eventKeyRelease: event "All keyboard events should go to the window I am serving so the user typing while the help popup is open is not lost." [ self targetWindowSensor ifNotNil: [ :targetSensor | targetSensor eventKeyRelease: event ] ] on: Error do: [ Transcript cr; show: 'HoverHelpSensor>>eventKeyRelease:'; flush ].
eventMouseMoved: event "The event is not a MouseMovedEvent so we can't rely on the event's globalPoint." [ HoverHelpWindow noticeMouseMoved: InputState default mousePoint. ] on: Error do: [ Transcript cr; show: 'HoverHelpSensor>>eventMouseMoved:'; flush ].
</methods> <methods> UI.HoverHelpSensor <category>accessing</category>
targetWindowSensor "We only want to pass events along if the window is alive." ^ window ifNotNil: [ :win | (win isInvalid not and: [ win isOpen ]) ifTrue: [ win targetWindowSensor ] ifFalse: [ nil ] ].
</methods> <methods> UI.TooltipAssistant <category>private</category>
buildStateMachine | coldState armedState reaperState | stateMachine := StateMachine new. "The first state defined becomes the initial state." coldState := stateMachine newState: #cold. armedState := stateMachine newState: #armed. reaperState := stateMachine newState: #reaper. coldState on: FrameEntered do: [self coldFrameEntered]. armedState on: HelpInterrupted do: [self armedHelpInterrupted]; on: FrameExited do: [self armedFrameExited]; afterMilliseconds: 800 do: [self armedTimeout]. reaperState on: HelpInterrupted do: [self reaperHelpInterrupted]; on: FrameExited do: [self reaperFrameExited]; afterMilliseconds: 5000 do: [self reaperTimeout]. stateMachine start.
isMyWindowActive ^view isOpen and: [view topComponent == Window currentWindow]
reserveWindow HoverHelpWindow reserveFor: view.
shouldOpenTooltipNow self log: (#shouldOpenNow, '=', HoverHelpWindow isCloseRecent printString). ^ HoverHelpWindow isCloseRecent.
subscriptions ^ FrameEntered, FrameExited, HelpInterrupted.
tooltipGraphic ^ [ self tooltip ifNotNil: [:supplier | supplier asTooltipGraphicFor: view ] ] on: Error do: [ :ex | Transcript cr; show: (#errTooltipGraphic << #dialogs >> 'Error building tooltipGraphic: <1s>' expandMacrosWith: ex errorString); flush ].
unreserveWindow HoverHelpWindow unreserve.
</methods> <methods> UI.TooltipAssistant <category>initialize-release</category>
release self closeTooltip. super release.
</methods> <methods> UI.TooltipAssistant <category>accessing</category>
closeTooltip HoverHelpWindow closeFor: view.
hasTooltip ^ self tooltipGraphic notNil.
openTooltip self tooltipGraphic ifNotNil: [ :tip | HoverHelpWindow openTooltip: tip for: view ].
tooltip ^ tooltip.
tooltip: anObject tooltip := anObject.
</methods> <methods> UI.TooltipAssistant <category>transitions</category>
armedFrameExited self unreserveWindow. self log: #coldArmedExit. stateMachine reset.
armedHelpInterrupted self unreserveWindow. self log: #coldArmedInterrupt. stateMachine reset.
armedTimeout self isMyWindowActive ifTrue: [self openTooltip. self log: #reaper. stateMachine enterStateNamed: #reaper] ifFalse: [self unreserveWindow. self log: #coldArmedTimeout. stateMachine reset]
coldFrameEntered "Be sure to respect the focus of the window containing the requesting view." view topComponent isActive ifFalse: [^self]. self hasTooltip ifTrue: [self shouldOpenTooltipNow ifTrue: [self armedTimeout] ifFalse: [self reserveWindow. self log: #armed. stateMachine enterStateNamed: #armed]]
reaperFrameExited self closeTooltip. self log: #coldReaperExit. stateMachine reset.
reaperHelpInterrupted self closeTooltip. self log: #coldReaperInterrupt. stateMachine reset.
reaperTimeout self closeTooltip. self log: #coldReaperTimeout. stateMachine reset.
</methods> <methods> UI.TextEditorView <category>accessing</category>
helpText: aStringOrText "This is the old API, use tooltip: instead. It's here for bw compatibility." self tooltip: aStringOrText.
</methods> <methods> UI.ProgressWidgetView <category>initialize-release</category>
helpText: aStringOrText "This is the old API, use tooltip: instead. It's here for bw compatibility." self tooltip: aStringOrText.
</methods> <methods> UI.SliderView <category>accessing</category>
helpText: aStringOrText "This is the old API, use tooltip: instead. It's here for bw compatibility." self tooltip: aStringOrText.
</methods> <methods> Graphics.VisualPart <category>tooltips</category>
addTooltipAssistant ^ self addTooltipAssistant: TooltipAssistant.
addTooltipAssistant: anAssistantClass ^ self propertyAt: #tooltipAssistant put: (anAssistantClass on: self).
</methods> <methods> Graphics.VisualPart <category>announcements</category>
announceHelpInterrupted "Something has happened that should interrupt any TooltipAssistant processing." self announce: (HelpInterrupted for: self)
</methods> <methods> Graphics.VisualPart <category>accessing</category>
tooltip ^ self tooltipAssistant ifNotNil: [:assistant | assistant tooltip].
tooltip: anObject "Set the tooltip of the reciever to be anObject. If anObject is nil, clear out the tooltip assistant. anObject may be any object that responds to asTooltipGraphicFor:. Currently this includes CharacterArrays (Strings, Text, etc), full blown VisualComponents (or Parts), UserMessages, or BlockClosures that return any of the previous types. We maintain one and only one tooltip assistant, keeping it in the lazy properties registry. While this is implemented in VisualPart, intercepting mouse/keyboard/window events depends on counterpart Controller behavior, so tooltips are only meaningful to do for a View object -- for now." anObject ifNil: [self tooltipAssistant ifNotNil: [:assistant | assistant release. self propertyAt: #tooltipAssistant put: nil]] ifNotNil: [(self tooltipAssistant ifNil: [self addTooltipAssistant]) tooltip: anObject]
</methods> <methods> Graphics.VisualPart <category>tooltips</category>
tooltipAssistant ^ self propertyAt: #tooltipAssistant.
</methods> <methods> UI.SequenceView <category>accessing</category>
helpText: aStringOrText "This is the old API, use tooltip: instead. It's here for bw compatibility." self tooltip: aStringOrText.
</methods> <methods> UI.WidgetPolicy <category>colors</category>
tooltipBackgroundColor ^ColorValue red: 1.0 green: 1.0 blue: 0.75
tooltipBorderColor ^ColorValue black
tooltipTextColor ^ColorValue black
</methods> <methods> Kernel.BlockClosure <category>accessing</category>
asTooltipGraphicFor: aVisualPart "Coerce the receiver into a graphic that is suitable for display in a hover help tooltip window. in this case, evaluate the receiver (a block) with aVisualPart as an optional argument. The block may return an object that is still not a graphic thing (e.g. aString), so repeat the application again, and make sure we don't get hung up on nils." ^(self cull: aVisualPart) ifNotNil: [:blockResult | blockResult asTooltipGraphicFor: aVisualPart]
</methods> <methods> UI.MotifWidgetPolicy <category>colors</category>
tooltipBackgroundColor ^ColorValue red: 0.933333 green: 0.882353 blue: 0.70
</methods> <methods> Kernel.UserMessage <category>accessing</category>
asTooltipGraphicFor: aVisualPart "Coerce the receiver into a graphic that is suitable for display in a hover help tooltip window. For this receiver, convert to a string and let that finish the job." ^self asString asTooltipGraphicFor: aVisualPart
</methods> <methods> Graphics.VisualComponent <category>accessing</category>
asTooltipGraphicFor: aVisualPart "Coerce the receiver into a graphic that is suitable for display in a hover help tooltip window. For this receiver, this is self. Other classes may do more, see implementors of this method for variants." ^self
</methods> <methods> UI.LabeledButtonView <category>accessing</category>
helpText: aStringOrText "This is the old API, use tooltip: instead. It's here for bw compatibility." self tooltip: aStringOrText.
</methods> <methods> Core.CharacterArray <category>accessing</category>
asTooltipGraphicFor: aVisualPart "Coerce the receiver into a graphic that is suitable for display in a hover help tooltip window. For text like objects, it is to build a graphic with the classic yellowish background and dark border. Consult the current policies of aVisualPart to get this right for the current look." | text widgetPolicy | widgetPolicy := aVisualPart widgetPolicy. text := ComposedText withText: self style: widgetPolicy lookPolicyClass systemTextStyle. ^VisualBlock block: [:gc :box | gc paint: widgetPolicy tooltipBorderColor; displayRectangle: box; paint: widgetPolicy tooltipBackgroundColor; intersectClip: (box insetBy: 1); displayRectangle: box; paint: widgetPolicy tooltipTextColor; display: text at: 4 @ 2] bounds: (Point zero extent: text bounds extent + (8 @ 4))
</methods> <methods> UI.MacOSXWidgetPolicy <category>colors</category>
tooltipBackgroundColor ^ColorValue red: 1.0 green: 1.0 blue: 0.825
tooltipBorderColor ^ColorValue brightness: 0.7
</methods> "Imported Classes:" self error: 'Attempting to file-in parcel imports. Choose terminate or close' <class> <name>Object</name> <environment>Core</environment> <super></super> <private>false</private> none <imports></imports> <category>Kernel-Objects</category> <attributes> <package>Kernel-Objects</package> </attributes> </class> <class> <name>VisualComponent</name> <environment>Graphics</environment> <super>Core.Object</super> <private>false</private> none <imports></imports> <category>Graphics-Visual Objects</category> <attributes> <package>Graphics-Visual Objects</package> </attributes> </class> <class> <name>VisualPart</name> <environment>Graphics</environment> <super>Graphics.VisualComponent</super> <private>false</private> none container eventHandlers properties <imports></imports> <category>Graphics-Visual Objects</category> <attributes> <package>Graphics-Visual Objects</package> </attributes> </class> <class> <name>ProgressWidgetView</name> <environment>UI</environment> <super>UI.View</super> <private>false</private> none axis lastValue position reverse area helpText <imports></imports> <category>UIBasics-Components</category> <attributes> <package>UIBasics-Components</package> </attributes> </class> <class> <name>EventSensor</name> <environment>UI</environment> <super>UI.ApplicationWindowSensor</super> <private>false</private> none collapseEvents queueLocked <imports></imports> <category>Interface-Events-Support</category> <attributes> <package>Interface-Events-Support</package> </attributes> </class> <class> <name>TransientWindow</name> <environment>UI</environment> <super>Graphics.Window</super> <private>false</private> none component paintPreferences isEventDriven controller <imports></imports> <category>Interface-Framework</category> <attributes> <package>Interface-Framework</package> </attributes> </class> <class> <name>WidgetPolicy</name> <environment>UI</environment> <super>Core.Object</super> <private>false</private> none defaultWidgetColors <imports></imports> <category>UIBuilder-Support</category> <attributes> <package>UIBuilder-Support</package> </attributes> </class> <class> <name>SequenceView</name> <environment>UI</environment> <super>UI.SelectionView</super> <private>false</private> none visualBlock selectedVisualBlock measureWidth cachedWidth helpText <imports></imports> <category>UIBasics-Components</category> <attributes> <package>UIBasics-Components</package> </attributes> </class> <class> <name>BlockClosure</name> <environment>Kernel</environment> <super>Core.Object</super> <private>false</private> none method outerContext copiedValues <imports></imports> <category>Kernel-Methods</category> <attributes> <package>Kernel-Methods</package> </attributes> </class> <class> <name>SliderView</name> <environment>UI</environment> <super>UI.SimpleView</super> <private>false</private> none axis markerBlock markerLength marker color1 color2 markerBorder rangeMap helpText <imports></imports> <category>UIBasics-Components</category> <attributes> <package>UIBasics-Components</package> </attributes> </class> <class> <name>MotifWidgetPolicy</name> <environment>UI</environment> <super>UI.WidgetPolicy</super> <private>false</private> none <imports></imports> <category>UILooks-Motif</category> <attributes> <package>UILooks-Motif</package> </attributes> </class> <class> <name>VisualPartAnnouncement</name> <environment>UI</environment> <super>Core.Announcement</super> <private>false</private> none part <imports></imports> <category>Interface-Announcements</category> <attributes> <package>Interface-Announcements</package> </attributes> </class> <class> <name>MacOSXWidgetPolicy</name> <environment>UI</environment> <super>UI.MacWidgetPolicy</super> <private>false</private> none <imports></imports> <category>UILooks-MacOSX</category> <attributes> <package>UILooks-MacOSX</package> </attributes> </class> <class> <name>CharacterArray</name> <environment>Core</environment> <super>Core.ArrayedCollection</super> <private>false</private> none <imports></imports> <category>Collections-Text</category> <attributes> <package>Collections-Text</package> </attributes> </class> <class> <name>UserMessage</name> <environment>Kernel</environment> <super>Core.Object</super> <private>false</private> none defaultString key catalogID <imports></imports> <category>UIBasics-Internationalization</category> <attributes> <package>UIBasics-Internationalization</package> </attributes> </class> <class> <name>LabeledButtonView</name> <environment>UI</environment> <super>UI.BasicButtonView</super> <private>false</private> none label textStyle helpText <imports></imports> <category>UIBasics-Components</category> <attributes> <package>UIBasics-Components</package> </attributes> </class> <class> <name>TextEditorView</name> <environment>UI</environment> <super>UI.ComposedTextView</super> <private>false</private> none state helpText <imports></imports> <category>UIBasics-Components</category> <attributes> <package>UIBasics-Components</package> </attributes> </class>