The Trunk: Morphic-mt.1175.mcz

Marcel Taeumel uploaded a new version of Morphic to project The Trunk:
http://source.squeak.org/trunk/Morphic-mt.1175.mcz

==================== Summary ====================

Name: Morphic-mt.1175
Author: mt
Time: 10 June 2016, 11:04:52.621631 am
UUID: aa560da5-379c-c542-adff-c909d0a671d2
Ancestors: Morphic-mt.1174

Adds mouse wheel events. For now, these events have to be synthesized from keystroke events (CTRL+up/down). There is a preference to control it.

If there are mouse-wheel events, then you can disable "Send Mouse Wheel To Keyboard Focus" to have Mac OS scroll-wheel-feeling. If you also enable #mouseOverForKeyboardFocus, you will not notice a difference.

This commit implements #mouseWheel: in ScrollPane but still has support for scroll-by-keyboard, that is, keystroke CTRL+up/down (via keyboard event filters, see ScrollPane >> #filterEvent:for:). This support might be removed in the future. For now, applications can disable "Synthesize Mouse Wheel Events" to not generate MouseWheel events at all and only rely on CTRL+up/down.

Note that this commit has a postscript in the Morphic package to install an event filter in all hands to do the conversion of CTRL+up/down to MouseWheelEvent. This is the first application of our new event filters to convert a keyboard event into a mouse event.

We should really update our VM to provide real mouse-wheel events... :-)

=============== Diff against Morphic-mt.1174 ===============

Item was changed:
  Object subclass: #EventHandler
+ instanceVariableNames: 'mouseDownRecipient mouseDownSelector mouseMoveRecipient mouseMoveSelector mouseStillDownRecipient mouseStillDownSelector mouseUpRecipient mouseUpSelector mouseEnterRecipient mouseEnterSelector mouseLeaveRecipient mouseLeaveSelector mouseEnterDraggingRecipient mouseEnterDraggingSelector mouseLeaveDraggingRecipient mouseLeaveDraggingSelector mouseWheelRecipient mouseWheelSelector keyStrokeRecipient keyStrokeSelector keyUpRecipient keyUpSelector keyDownRecipient keyDownSelector valueParameter startDragRecipient startDragSelector doubleClickSelector doubleClickRecipient doubleClickTimeoutSelector doubleClickTimeoutRecipient clickSelector clickRecipient keyboardFocusChangeRecipient keyboardFocusChangeSelector wantsEveryMouseMove'
- instanceVariableNames: 'mouseDownRecipient mouseDownSelector mouseMoveRecipient mouseMoveSelector mouseStillDownRecipient mouseStillDownSelector mouseUpRecipient mouseUpSelector mouseEnterRecipient mouseEnterSelector mouseLeaveRecipient mouseLeaveSelector mouseEnterDraggingRecipient mouseEnterDraggingSelector mouseLeaveDraggingRecipient mouseLeaveDraggingSelector keyStrokeRecipient keyStrokeSelector keyUpRecipient keyUpSelector keyDownRecipient keyDownSelector valueParameter startDragRecipient startDragSelector doubleClickSelector doubleClickRecipient doubleClickTimeoutSelector doubleClickTimeoutRecipient clickSelector clickRecipient keyboardFocusChangeRecipient keyboardFocusChangeSelector wantsEveryMouseMove'
  classVariableNames: ''
  poolDictionaries: ''
  category: 'Morphic-Events'!
 
  !EventHandler commentStamp: '<historical>' prior: 0!
  Events in Morphic originate in a Hand, pass to a target morph, and are then dispatched by an EventHandler.  EventHandlers support redirection of mouse and keyboard activity by specifying and independent recipient object and message selector for each of the possible events.  In addition each eventHandler can supply an optional value parameter for distinguishing between, eg, events from a number of otherwise identical source morphs.
 
  The basic protocol of an event handler is to receive a message of the form
  mouseDown: event in: targetMorph
  and redirect this as one of
  mouseDownRecipient perform: mouseDownSelector0
  mouseDownRecipient perform: mouseDownSelector1 with: event
  mouseDownRecipient perform: mouseDownSelector2 with: event with: targetMorph
  mouseDownRecipient perform: mouseDownSelector3 with: event with: targetMorph with: valueParameter
  depending on the arity of the mouseDownSelector.
  !

Item was added:
+ ----- Method: EventHandler>>handlesMouseWheel: (in category 'testing') -----
+ handlesMouseWheel: evt
+ mouseWheelRecipient ifNotNil: [^ true].
+ ^ false!

Item was added:
+ ----- Method: EventHandler>>mouseWheel:fromMorph: (in category 'events') -----
+ mouseWheel: event fromMorph: sourceMorph
+ ^ self
+ send: mouseWheelSelector
+ to: mouseWheelRecipient
+ withEvent: event
+ fromMorph: sourceMorph!

Item was changed:
  ----- Method: EventHandler>>on:send:to: (in category 'initialization') -----
  on: eventName send: selector to: recipient
  eventName == #mouseDown ifTrue:
  [mouseDownRecipient := recipient.  mouseDownSelector := selector. ^ self].
  eventName == #mouseMove ifTrue:
  [mouseMoveRecipient := recipient.  mouseMoveSelector := selector. ^ self].
  eventName == #mouseStillDown ifTrue:
  [mouseStillDownRecipient := recipient.  mouseStillDownSelector := selector. ^ self].
  eventName == #mouseUp ifTrue:
  [mouseUpRecipient := recipient.  mouseUpSelector := selector. ^ self].
  eventName == #mouseEnter ifTrue:
  [mouseEnterRecipient := recipient.  mouseEnterSelector := selector. ^ self].
  eventName == #mouseLeave ifTrue:
  [mouseLeaveRecipient := recipient.  mouseLeaveSelector := selector. ^ self].
  eventName == #mouseEnterDragging ifTrue:
  [mouseEnterDraggingRecipient := recipient.  mouseEnterDraggingSelector := selector. ^ self].
  eventName == #mouseLeaveDragging ifTrue:
  [mouseLeaveDraggingRecipient := recipient.  mouseLeaveDraggingSelector := selector. ^ self].
  eventName == #click ifTrue:
  [clickRecipient := recipient. clickSelector := selector. ^ self].
  eventName == #doubleClick ifTrue:
  [doubleClickRecipient := recipient. doubleClickSelector := selector. ^ self].
  eventName == #doubleClickTimeout ifTrue:
  [doubleClickTimeoutRecipient := recipient. doubleClickTimeoutSelector := selector. ^ self].
  eventName == #startDrag ifTrue:
  [startDragRecipient := recipient. startDragSelector := selector. ^ self].
+ eventName == #mouseWheel ifTrue:
+ [mouseWheelRecipient := recipient. mouseWheelSelector := selector. ^ self].
  eventName == #keyStroke ifTrue:
  [keyStrokeRecipient := recipient.  keyStrokeSelector := selector. ^ self].
  eventName == #keyUp ifTrue:
  [keyUpRecipient := recipient.  keyUpSelector := selector. ^ self].
  eventName == #keyDown ifTrue:
  [keyDownRecipient := recipient.  keyDownSelector := selector. ^ self].
  eventName == #keyboardFocusChange ifTrue:
  [keyboardFocusChangeRecipient := recipient. keyboardFocusChangeSelector := selector. ^ self].
  eventName == #gesture ifTrue:
  [ ^self onGestureSend: selector to: recipient ].
  self error: 'Event name, ' , eventName , ' is not recognizable.'
  !

Item was changed:
  ----- Method: EventHandler>>printOn: (in category 'printing') -----
  printOn: aStream
  | recipients |
  super printOn: aStream.
+ #('mouseDownSelector' 'mouseStillDownSelector' 'mouseUpSelector' 'mouseEnterSelector' 'mouseLeaveSelector' 'mouseEnterDraggingSelector' 'mouseLeaveDraggingSelector' 'mouseWheelSelector' 'doubleClickSelector' 'keyStrokeSelector' 'keyUpSelector' 'keyDownSelector' 'startDragSelector' 'clickSelector' 'keyboardFocusChangeSelector')
- #('mouseDownSelector' 'mouseStillDownSelector' 'mouseUpSelector' 'mouseEnterSelector' 'mouseLeaveSelector' 'mouseEnterDraggingSelector' 'mouseLeaveDraggingSelector' 'doubleClickSelector' 'keyStrokeSelector')
  do:
  [:aName | | aVal |
  (aVal := self instVarNamed: aName) notNil
  ifTrue: [aStream nextPutAll: '; ' , aName , '=' , aVal]].
  (recipients := self allRecipients) notEmpty
  ifTrue:
  [aStream nextPutAll: ' recipients: '.
  recipients printOn: aStream]!

Item was changed:
  Morph subclass: #HandMorph
  instanceVariableNames: 'mouseFocus keyboardFocus eventListeners mouseListeners keyboardListeners eventCaptureFilters mouseCaptureFilters keyboardCaptureFilters mouseClickState mouseOverHandler lastMouseEvent targetOffset damageRecorder cacheCanvas cachedCanvasHasHoles temporaryCursor temporaryCursorOffset hardwareCursor hasChanged savedPatch userInitials lastEventBuffer genieGestureProcessor keyboardInterpreter'
+ classVariableNames: 'CompositionWindowManager DoubleClickTime DragThreshold EventStats NewEventRules NormalCursor PasteBuffer SendMouseWheelToKeyboardFocus ShowEvents SynthesizeMouseWheelEvents'
- classVariableNames: 'CompositionWindowManager DoubleClickTime DragThreshold EventStats NewEventRules NormalCursor PasteBuffer ShowEvents'
  poolDictionaries: 'EventSensorConstants'
  category: 'Morphic-Kernel'!
 
  !HandMorph commentStamp: '<historical>' prior: 0!
  The cursor may be thought of as the HandMorph.  The hand's submorphs hold anything being carried by dragging.  
 
  There is some minimal support for multiple hands in the same world.!

Item was added:
+ ----- Method: HandMorph class>>sendMouseWheelToKeyboardFocus (in category 'preferences') -----
+ sendMouseWheelToKeyboardFocus
+ <preference: 'Send Mouse Wheel Events to Keyboard Focus'
+ categoryList: #(Morphic keyboard mouse)
+ description: 'If enabled, follow the behavior known from Microsoft Windows, where the mouse wheel works for the widget that has the keyboard focus. If disabled, follow the Mac OS style, where the mouse wheel is send to the widget under the mouse position'
+ type: #Boolean>
+ ^ SendMouseWheelToKeyboardFocus ifNil: [true]!

Item was added:
+ ----- Method: HandMorph class>>sendMouseWheelToKeyboardFocus: (in category 'preferences') -----
+ sendMouseWheelToKeyboardFocus: aBoolean
+ SendMouseWheelToKeyboardFocus := aBoolean.!

Item was added:
+ ----- Method: HandMorph class>>synthesizeMouseWheelEvents (in category 'preferences') -----
+ synthesizeMouseWheelEvents
+ <preference: 'Synthesize Mouse Wheel Events from Keyboard Events'
+ categoryList: #(Morphic keyboard mouse)
+ description: 'If enabled, convert CTRL+Up/Down (keystroke with modifier key) to mouse wheel up/down. Disable this according to the current VM behavior.'
+ type: #Boolean>
+ ^ SynthesizeMouseWheelEvents ifNil: [true]!

Item was added:
+ ----- Method: HandMorph class>>synthesizeMouseWheelEvents: (in category 'preferences') -----
+ synthesizeMouseWheelEvents: aBoolean
+ SynthesizeMouseWheelEvents := aBoolean.!

Item was added:
+ ----- Method: HandMorph>>filterEvent:for: (in category 'events-filtering') -----
+ filterEvent: aKeyboardEvent for: aMorphOrNil
+ "Fixes VM behavior. Usually, there are no mouse wheel events generated by the VM but CTRL+UP/DOWN. Convert these into mouse wheel events.
+
+ We installed ourself as keyboard filter only!! No need to check whether this is a keyboard event or not!! See HandMorph >> #initForEvents.
+
+ Might be removed in the future if this mapping gets obsolete."
+
+ HandMorph synthesizeMouseWheelEvents ifFalse: [^ aKeyboardEvent].
+
+ (aKeyboardEvent isKeystroke and: [aKeyboardEvent controlKeyPressed]) ifTrue: [
+ aKeyboardEvent keyCharacter caseOf: {
+ [Character arrowUp] -> [^ self generateMouseWheelEvent: aKeyboardEvent direction: #up].
+ [Character arrowDown] -> [^ self generateMouseWheelEvent: aKeyboardEvent direction: #down].
+ } otherwise: [^ aKeyboardEvent]].
+
+ ^ aKeyboardEvent!

Item was added:
+ ----- Method: HandMorph>>generateMouseWheelEvent:direction: (in category 'private events') -----
+ generateMouseWheelEvent: keystrokeEvent direction: directionSymbol
+ "Generate the appropriate mouse wheel event from the keystrokeEvent. Before calling this, ensure that the control key is pressed."
+
+ ^ MouseWheelEvent new
+ setType: #mouseWheel
+ position: keystrokeEvent position
+ direction: directionSymbol
+ buttons: (keystrokeEvent buttons bitAnd: 2r01111) "drop control key pressed for this conversion"
+ hand: keystrokeEvent hand
+ stamp: keystrokeEvent timeStamp!

Item was changed:
  ----- Method: HandMorph>>handleEvent: (in category 'events-processing') -----
  handleEvent: unfilteredEvent
 
  | filteredEvent |
  owner ifNil: [^ unfilteredEvent  "not necessary but good style -- see Morph >> #handleEvent:"].
 
  self logEvent: unfilteredEvent.
 
  "Mouse-over events occur really, really, really often. They are kind of the heart beat of the Morphic UI process."
  unfilteredEvent isMouseOver ifTrue: [^ self sendMouseEvent: unfilteredEvent].
 
  self showEvent: unfilteredEvent.
  self sendListenEvents: unfilteredEvent.
 
  filteredEvent := self sendFilterEventCapture: unfilteredEvent for: nil.
  "filteredEvent := unfilteredEvent" " <-- use this to disable global capture filters"
 
  filteredEvent wasIgnored ifTrue: [
  self mouseOverHandler processMouseOver: lastMouseEvent.
  ^ filteredEvent].
 
  filteredEvent isWindowEvent ifTrue: [
  self sendEvent: filteredEvent focus: nil.
  self mouseOverHandler processMouseOver: lastMouseEvent.
  ^ filteredEvent].
 
  filteredEvent isKeyboard ifTrue:[
  self sendKeyboardEvent: filteredEvent.
  self mouseOverHandler processMouseOver: lastMouseEvent.
  ^ filteredEvent].
 
  filteredEvent isDropEvent ifTrue:[
  self sendEvent: filteredEvent focus: nil.
  self mouseOverHandler processMouseOver: lastMouseEvent.
  ^ filteredEvent].
 
  filteredEvent isMouse ifFalse: [
  self mouseOverHandler processMouseOver: lastMouseEvent.
  ^ filteredEvent].
 
  " ********** MOUSE EVENT *********** "
 
  lastMouseEvent := filteredEvent.
 
  "Check for pending drag or double click operations."
  mouseClickState ifNotNil:[
  (mouseClickState handleEvent: filteredEvent from: self) ifFalse:[
  "Possibly dispatched #click: or something and will not re-establish otherwise"
  self mouseOverHandler processMouseOver: lastMouseEvent.
  ^ filteredEvent]].
 
  filteredEvent isMove ifTrue:[
  self position: filteredEvent position.
  self sendMouseEvent: filteredEvent.
  self mouseOverHandler processMouseOver: lastMouseEvent.
  ^ filteredEvent].
 
  "Issue a synthetic move event if we're not at the position of the event"
  filteredEvent position = self position
  ifFalse: [self moveToEvent: filteredEvent].
 
  "Drop submorphs on button events"
  self hasSubmorphs
  ifTrue:[self dropMorphs: filteredEvent]
+ ifFalse:[
+ "This check is here and not in #sendMouseEvent: to avoid unnecessary comparisons for mouse-over events."
+ (HandMorph sendMouseWheelToKeyboardFocus and: [filteredEvent isMouseWheel])
+ ifFalse: [self sendMouseEvent: filteredEvent]
+ ifTrue: [self sendEvent: filteredEvent focus: self keyboardFocus clear: [self keyboardFocus: nil]]].
- ifFalse:[self sendMouseEvent: filteredEvent].
 
  self mouseOverHandler processMouseOver: lastMouseEvent.
  ^ filteredEvent "not necessary but good style -- see Morph >> #handleEvent:" !

Item was changed:
  ----- Method: HandMorph>>initForEvents (in category 'initialization') -----
  initForEvents
  mouseOverHandler := nil.
  lastMouseEvent := MouseEvent new setType: #mouseMove position: 0@0 buttons: 0 hand: self.
  lastEventBuffer := {1. 0. 0. 0. 0. 0. nil. nil}.
+ self resetClickState.
+ self addKeyboardCaptureFilter: self. "to convert unusual VM events"!
- self resetClickState.!

Item was changed:
  ----- Method: HandMorph>>showEvent: (in category 'events-debugging') -----
  showEvent: anEvent
  "Show details about the event on the display form. Useful for debugging."
 
+ | message borderWidth |
- | ofs |
  ShowEvents == true ifFalse: [^ self].
 
+ borderWidth := 5.
+ message := String streamContents: [:strm |
+ strm
+ nextPutAll: '[HandMorph >> #showEvent:]'; cr;
+ nextPutAll: 'event'; tab; tab; tab; tab; nextPutAll: anEvent printString; cr;
+ nextPutAll: 'keyboard focus'; tab; nextPutAll: self keyboardFocus printString; cr;
+ nextPutAll: 'mouse focus'; tab; tab; nextPutAll: self mouseFocus printString].
+
+ message := message asDisplayText
+ foregroundColor: Color black
+ backgroundColor: Color white.
+
+ "Offset to support multiple hands debugging."
+ Display fill: (0 @ 0 extent: message form extent + (borderWidth asPoint * 2)) rule: Form over fillColor: Color white.
+ message displayOn: Display at: borderWidth asPoint + (0 @  ((owner hands indexOf: self) - 1 * message form height)).!
- Display fill: (0@0 extent: 300@120) rule: Form over fillColor: Color white.
- ofs := (owner hands indexOf: self) - 1 * 60.
-
- anEvent isKeyboard
- ifTrue: [ 'key: ', anEvent printString displayAt: (0@ofs) + (0@30) ]
- ifFalse: [ 'evt ', anEvent printString displayAt: (0@ofs) + (0@0) ].
-
- 'kf:  ', self keyboardFocus printString displayAt: (0@ofs)+(0@45).
- 'mf: ', self mouseFocus printString displayAt: (0@ofs) + (0@15)
- !

Item was changed:
  ----- Method: KeyboardEvent>>printOn: (in category 'printing') -----
  printOn: aStream
  "Print the receiver on a stream"
 
  aStream nextPut: $[.
+ aStream nextPutAll: self cursorPoint printString; space.
  aStream nextPutAll: type; nextPutAll: ' '''.
  self printKeyStringOn: aStream.
+ aStream nextPut: $'; space.
+ aStream nextPutAll: timeStamp printString.
- aStream nextPut: $'.
  aStream nextPut: $]!

Item was added:
+ ----- Method: Morph>>handleMouseWheel: (in category 'events-processing') -----
+ handleMouseWheel: anEvent
+ "System level event handling."
+
+ anEvent wasHandled ifTrue: [^self].
+ (self handlesMouseWheel: anEvent) ifFalse: [^ self].
+ anEvent wasHandled: true.
+ ^ self mouseWheel: anEvent!

Item was added:
+ ----- Method: Morph>>handlesMouseWheel: (in category 'event handling') -----
+ handlesMouseWheel: evt
+ "Do I want to receive mouseWheel events? The default response is false, except if you have added sensitivity to mouseWheel events using the on:send:to: mechanism.  Subclasses that implement these messages directly should override this one to return true."
+
+ self eventHandler ifNotNil: [^ self eventHandler handlesMouseWheel: evt].
+ ^ false!

Item was added:
+ ----- Method: Morph>>mouseWheel: (in category 'event handling') -----
+ mouseWheel: anEvent
+ "Handle a mouse wheel event. The default response is to let my eventHandler, if any, handle it."
+
+ self eventHandler ifNotNil: [:handler |
+ handler mouseWheel: anEvent fromMorph: self].!

Item was changed:
  ----- Method: MorphicEvent class>>readFrom: (in category 'instance creation') -----
  readFrom: aStream
  "Read a MorphicEvent from the given stream."
  | typeString |
  typeString := String streamContents:
  [:s | | c |   [(c := aStream next) isLetter] whileTrue: [s nextPut: c]].
  typeString = 'mouseMove' ifTrue:[^MouseMoveEvent type: #mouseMove readFrom: aStream].
  typeString = 'mouseDown' ifTrue:[^MouseButtonEvent type: #mouseDown readFrom: aStream].
  typeString = 'mouseUp' ifTrue:[^MouseButtonEvent type: #mouseUp readFrom: aStream].
+ typeString = 'mouseWheel' ifTrue:[^MouseWheelEvent type: #mouseWheel readFrom: aStream].
 
  typeString = 'keystroke' ifTrue:[^KeyboardEvent type: #keystroke readFrom: aStream].
  typeString = 'keyDown' ifTrue:[^KeyboardEvent type: #keyDown readFrom: aStream].
  typeString = 'keyUp' ifTrue:[^KeyboardEvent type: #keyUp readFrom: aStream].
 
  typeString = 'mouseOver' ifTrue:[^MouseEvent type: #mouseOver readFrom: aStream].
  typeString = 'mouseEnter' ifTrue:[^MouseEvent type: #mouseEnter readFrom: aStream].
  typeString = 'mouseLeave' ifTrue:[^MouseEvent type: #mouseLeave readFrom: aStream].
 
  typeString = 'unknown' ifTrue:[^MorphicUnknownEvent type: #unknown readFrom: aStream].
 
  ^nil
  !

Item was added:
+ ----- Method: MouseButtonEvent>>printOn: (in category 'printing') -----
+ printOn: aStream
+
+ aStream nextPut: $[.
+ aStream nextPutAll: self cursorPoint printString; space.
+ aStream nextPutAll: type; space.
+ aStream nextPutAll: self modifierString.
+ aStream nextPutAll: self buttonString.
+ aStream nextPutAll: self whichButtonString; space.
+ aStream nextPutAll: timeStamp printString.
+ aStream nextPut: $].!

Item was added:
+ ----- Method: MouseButtonEvent>>whichButtonString (in category 'printing') -----
+ whichButtonString
+ "Return a string identifying the changed buttons"
+
+ ^ String streamContents: [:stream |
+ stream nextPutAll: '( '.
+ self redButtonChanged ifTrue: [stream nextPutAll: 'red '].
+ self yellowButtonChanged ifTrue: [stream nextPutAll: 'yellow '].
+ self blueButtonChanged ifTrue: [stream nextPutAll: 'blue '].
+ stream nextPutAll: ')']!

Item was added:
+ ----- Method: MouseEvent>>isMouseWheel (in category 'testing') -----
+ isMouseWheel
+ ^ false!

Item was added:
+ MouseEvent subclass: #MouseWheelEvent
+ instanceVariableNames: 'direction'
+ classVariableNames: ''
+ poolDictionaries: ''
+ category: 'Morphic-Events'!

Item was added:
+ ----- Method: MouseWheelEvent>>direction (in category 'accessing') -----
+ direction
+ ^ direction!

Item was added:
+ ----- Method: MouseWheelEvent>>isMouseWheel (in category 'testing') -----
+ isMouseWheel
+ ^ true!

Item was added:
+ ----- Method: MouseWheelEvent>>isWheelDown (in category 'testing') -----
+ isWheelDown
+ ^ self direction == #down!

Item was added:
+ ----- Method: MouseWheelEvent>>isWheelLeft (in category 'testing') -----
+ isWheelLeft
+ ^ self direction == #left!

Item was added:
+ ----- Method: MouseWheelEvent>>isWheelRight (in category 'testing') -----
+ isWheelRight
+ ^ self direction == #right!

Item was added:
+ ----- Method: MouseWheelEvent>>isWheelUp (in category 'testing') -----
+ isWheelUp
+ ^ self direction == #up!

Item was added:
+ ----- Method: MouseWheelEvent>>printOn: (in category 'printing') -----
+ printOn: aStream
+
+ aStream nextPut: $[.
+ aStream nextPutAll: self cursorPoint printString; space.
+ aStream nextPutAll: type; space.
+ aStream print: self direction; space.
+ aStream nextPutAll: self modifierString.
+ aStream nextPutAll: self buttonString.
+ aStream nextPutAll: timeStamp printString; space.
+ aStream nextPut: $].!

Item was added:
+ ----- Method: MouseWheelEvent>>sentTo: (in category 'dispatching') -----
+ sentTo: anObject
+ "Dispatch the receiver into anObject"
+ type == #mouseWheel ifTrue: [^ anObject handleMouseWheel: self].
+ ^ super sentTo: anObject!

Item was added:
+ ----- Method: MouseWheelEvent>>setType:position:direction:buttons:hand:stamp: (in category 'private') -----
+ setType: evtType position: evtPos direction: dirSymbol buttons: evtButtons hand: evtHand stamp: stamp
+ type := evtType.
+ position := evtPos.
+ buttons := evtButtons.
+ source := evtHand.
+ wasHandled := false.
+ direction := dirSymbol.
+ timeStamp := stamp.!

Item was added:
+ ----- Method: MouseWheelEvent>>storeOn: (in category 'printing') -----
+ storeOn: aStream
+
+ super storeOn: aStream.
+ aStream space.
+ self direction storeOn: aStream.!

Item was added:
+ ----- Method: MouseWheelEvent>>type:readFrom: (in category 'initialization') -----
+ type: eventType readFrom: aStream
+
+ super type: eventType readFrom: aStream.
+ aStream skip: 1.
+ direction := Symbol readFrom: aStream.
+ !

Item was changed:
  ----- Method: PluggableListMorph>>keyStroke: (in category 'event handling') -----
  keyStroke: event
  "Process keys
  The model is allowed to preview all keystrokes. If it's not interested:
  specialKeys are things like up, down, etc. ALWAYS HANDLED
  modifierKeys are regular characters either 1) accompanied with ctrl,
  cmd or 2) any character if the list doesn't want to handle basic
  keys (handlesBasicKeys returns false)
  basicKeys are any characters"
 
  | aChar aSpecialKey |
  (self previewKeystroke: event)
  ifTrue: [^ self].
- (self scrollByKeyboard: event)
- ifTrue: [^ self].
 
  aChar := event keyCharacter.
 
  (aSpecialKey := aChar asciiValue) < 32
  ifTrue: [^ self specialKeyPressed: aSpecialKey].
 
  (event anyModifierKeyPressed or: [self handlesBasicKeys not])
  ifTrue: [^ self modifierKeyPressed: aChar].
 
  ^ self basicKeyPressed: aChar!

Item was added:
+ ----- Method: ScrollPane>>filterEvent:for: (in category 'event filtering') -----
+ filterEvent: aKeyboardEvent for: morphOrNil
+ "See #initialize. This filter should be installed as keyboard event filter during the capture phase."
+
+ ^ aKeyboardEvent
+ wasIgnored: (self scrollByKeyboard: aKeyboardEvent);
+ yourself!

Item was added:
+ ----- Method: ScrollPane>>handlesMouseWheel: (in category 'event handling') -----
+ handlesMouseWheel: evt
+ ^ true!

Item was changed:
  ----- Method: ScrollPane>>initialize (in category 'initialization') -----
  initialize
 
  "initialize the state of the receiver"
  super initialize.
  ""
  self initializePreferences.
  hasFocus := false.
  self initializeScrollBars.
  ""
 
  self extent: self defaultExtent.
  self
  resizeScrollBars;
  resizeScroller;
  hideOrShowScrollBars;
+ updateMinimumExtent.
+
+ self addKeyboardCaptureFilter: self.!
- updateMinimumExtent.!

Item was changed:
  ----- Method: ScrollPane>>keyStroke: (in category 'event handling') -----
  keyStroke: evt
  "If pane is not empty, pass the event to the last submorph,
   assuming it is the most appropriate recipient (!!)"
 
- (self scrollByKeyboard: evt) ifTrue: [^self].
  scroller submorphs last keyStroke: evt!

Item was added:
+ ----- Method: ScrollPane>>mouseWheel: (in category 'event handling') -----
+ mouseWheel: evt
+
+ evt isWheelUp ifTrue: [scrollBar scrollUp: 3].
+ evt isWheelDown ifTrue: [scrollBar scrollDown: 3].!

Item was changed:
  ----- Method: ScrollPane>>scrollByKeyboard: (in category 'event handling') -----
  scrollByKeyboard: event
+ "If event is ctrl+up/down then scroll and answer true. Backwards compatibility."
+
+ (event controlKeyPressed or:[event commandKeyPressed "??? key decode table in event sensor does not change CTRL+up/down !!!!!!"]) ifFalse: [^ false].
- "If event is ctrl+up/down then scroll and answer true"
- (event controlKeyPressed or:[event commandKeyPressed]) ifFalse: [^ false].
  event keyCharacter = Character arrowUp
  ifTrue:
  [scrollBar scrollUp: 3.
  ^ true].
  event keyCharacter = Character arrowDown
  ifTrue:
  [scrollBar scrollDown: 3.
  ^ true].
  "event keyCharacter = Character arrowRight
  ifTrue:
  [hScrollBar scrollDown: 3.
  ^ true].
  event keyCharacter = Character arrowLeft
  ifTrue:
  [hScrollBar scrollUp: 3.
  ^ true]."
  ^ false!

Item was changed:
  ----- Method: SimpleHierarchicalListMorph>>keyStroke: (in category 'event handling') -----
  keyStroke: event
  "Process potential command keys"
-
- (self scrollByKeyboard: event) ifTrue: [^ true].
 
  event keyCharacter asciiValue < 32 ifTrue: [
  ^ self specialKeyPressed: event keyCharacter asciiValue].
 
  " A lot of actions do not return a Boolean here (#messageListKey:from:,
  #classListKey:from:, ...); even most #arrowKey:from: implementors do not.
  Hence, we explicitely check for false and else assume truthieness"
  ^ (self keyStrokeAction: event) ~~ false
  !

Item was changed:
  ----- Method: TextMorphForEditView>>keyStroke: (in category 'event handling') -----
  keyStroke: evt
  | view |
  editView deleteBalloon.
- (editView scrollByKeyboard: evt) ifTrue: [^self].
  self editor model: editView model.  "For evaluateSelection"
  view := editView.  "Copy into temp for case of a self-mutating doit"
  (acceptOnCR and: [evt keyCharacter = Character cr])
  ifTrue: [^ self editor accept].
  super keyStroke: evt.
  view scrollSelectionIntoView.
 
  "Make a cheap check and guess editing. (Alternative would be to copy the old contents and then compare them against the new ones. Maybe add a better hook in the TextEditor."
  (self readOnly not and: [evt keyCharacter isAlphaNumeric or: [evt keyCharacter isSeparator]])
  ifTrue: [view textEdited: self contents].!

Item was changed:
+ (PackageInfo named: 'Morphic') postscript: '"Fixes the event handling that occurs in the same control flow after loading this code."
+ HandMorph allInstancesDo: [:ea | ea initForEvents].
- (PackageInfo named: 'Morphic') postscript: 'HandMorph allInstancesDo: [:ea | ea initForEvents]. "Fixes the event handling that occurs in the same control flow after loading this code."
 
+ "Deploy mouse-wheel event handling to existing scrollpanes and hands."
+ Project allMorphicProjects do: [:morphicProject |
+ morphicProject world handsDo: [:hand |
+ hand addKeyboardCaptureFilter: hand]].
+ ScrollPane allSubInstancesDo: [:ea |
+ ea addKeyboardCaptureFilter: ea].'!
- SystemWindow allSubInstancesDo: [:ea |
- ea initializeKeyboardShortcuts.
- HandMorph allInstancesDo: [:hand | hand removeKeyboardListener: ea]].
- PasteUpMorph allSubInstancesDo: [:ea |
- ea initializeKeyboardShortcuts.
- HandMorph allInstancesDo: [:hand | hand removeKeyboardListener: ea]].
- DockingBarMorph allSubInstancesDo: [:ea |
- HandMorph allInstancesDo: [:hand | hand removeKeyboardListener: ea]].'!