[squeak-dev] The Trunk: Morphic-nice.1635.mcz

Chris Muller asqueaker at gmail.com
Sat Mar 7 00:58:25 UTC 2020


Would you be willing to find another way to re-read the same thing multiple
times than bloating the image with multiple copies of the same text?  Would
you be willing to find another way to re-read the same thing multiple times
than bloating the image with multiple copies of the same text?

On Fri, Mar 6, 2020 at 6:07 PM Jakob Reschke <forums.jakob at resfarm.de>
wrote:

> I find it convenient to re-read here what was merged, without reading
> the source code diff or looking up other mails.
> But I agree it would be even better if original changes introduced
> during the merge were pointed out at the top, not in between or at the
> bottom. I overlooked the "integrator note" until after Chris replied.
>
> Am Sa., 7. März 2020 um 00:51 Uhr schrieb Chris Muller <
> asqueaker at gmail.com>:
> >
> > Versions about merging can be concisely described with merely "Merge."
> and actually provide a clearer description of what that Version object is
> about -- a merge, not code changes.  Since they're a unit of change of the
> ancestry, not the code, including the prior descriptions about code changes
> isn't necessary and even adds some confusion whether this is a simple merge
> or something more..
> >
> > IMO, the original descriptions should remain with the original
> submissions _only_.
> >
> >  - Chris
> >
> > On Fri, Mar 6, 2020 at 4:54 PM <commits at source.squeak.org> wrote:
> >>
> >> Nicolas Cellier uploaded a new version of Morphic to project The Trunk:
> >> http://source.squeak.org/trunk/Morphic-nice.1635.mcz
> >>
> >> ==================== Summary ====================
> >>
> >> Name: Morphic-nice.1635
> >> Author: nice
> >> Time: 6 March 2020, 11:54:05.017411 pm
> >> UUID: 2db3548c-1ac5-4197-bf5e-2df91ee604ed
> >> Ancestors: Morphic-mt.1634, Morphic-nice.1616, Morphic-ct.1622,
> Morphic-cmm.1489
> >>
> >> Merge Morphic-mt.1634, Morphic-nice.1616, Morphic-ct.1622,
> Morphic-cmm.1489
> >>
> >> Mainly set smoother scrolling in postscript now that our VM support
> that.
> >> Note that this removes shared mouseWheelState as discussed in thread
> >>
> http://lists.squeakfoundation.org/pipermail/squeak-dev/2020-January/206227.html
> >> (this was Morphic-nice.1613, but was refactored a bit since then).
> >>
> >> Morphic-nice.1616:
> >>         Provide smoother scrolling in response to mouse wheel events
> >>
> >> Instead of delivering the events when wheelDelta reaches 120, make this
> threshold a Preference (minimumWheelDelta)
> >>
> >> Reminder: 120 represents a single notch for traditional mouse wheel
> with notches, but trackpads can deliver much smaller deltas
> >>
> >> Rather than accumulating the wheelDeltas into MouseWheelState, do it
> when we #generateMouseWheelEvent:
> >> Indeed, small deltas will come in packets of successive events, and
> it's more efficient to regroup then, exactly like we do with mouse trails...
> >>
> >> Also MouseWheelState did ignore time outs (long delays between deltas)
> and other state changes (buttons/modifiers), which was not ideal.
> >>
> >> Directly get those states from the raw eventBuffer, like any other
> mouse event. This requires integration of tose 2 PR:
> >> https://github.com/OpenSmalltalk/opensmalltalk-vm/pull/461 for Windows
> >> https://github.com/OpenSmalltalk/opensmalltalk-vm/pull/462 for OSX and
> linux
> >>
> >> Honour larger wheelDeltas too in ScrollPane>>#mouseWheel: event handling
> >> Honour horizontal mouse wheels too in ScrollPane
> >> Note that the scroll pane still won't deliver
> sub-scrollDeltaWidth/scrollDeltaHeight with those changes, the number of
> scroll deltas is still rounded to 1.
> >>
> >> With patched VM, and following settings, I get a reasonnable scrolling
> experience on OSX:
> >>
> >>         HandMorph minimumWheelDelta: 20.
> >>         Smalltalk sendMouseWheelEvents: true.
> >>
> >> NOTE: it is tricky to add/remove inst. var. to such HandMorph because
> obsolete CompiledMethod pointing to old inst. var. offset are still active
> on the stack and can mess things up (unless you do not load the package
> from UI but rather from command line...).
> >>
> >> Since accessing 'lastMouseEvent' in such obsolete CompiledMethod is
> causing grief, preserve its offset by swapping inst. var. order with
> 'targetOffset' which is less likely used.
> >>
> >> Morphic-ct.1622:
> >>         Proposal: Swap key and item of an Integer's explorer contents.
> Integer representations are not really keys, but rather values. In an
> explorer's code pane, this allows you to interact with the selected string
> representation (for example '101010') which is much more interesting than
> the base name (for example 'binary').
> >>
> >> Morphic-cmm.1489:
> >>         Fix TextEditor>>#hasMultipleLinesSelected to consider actual
> lines, instead of wrapped lines.
> >>
> >> integrator note: but I also let it consider case of LF
> >>
> >> =============== Diff against Morphic-mt.1634 ===============
> >>
> >> Item was changed:
> >>   Morph subclass: #HandMorph
> >> +       instanceVariableNames: 'mouseFocus keyboardFocus eventListeners
> mouseListeners keyboardListeners eventCaptureFilters mouseCaptureFilters
> keyboardCaptureFilters mouseClickState mouseOverHandler targetOffset
> lastMouseEvent damageRecorder cacheCanvas cachedCanvasHasHoles
> temporaryCursor temporaryCursorOffset hardwareCursor hasChanged savedPatch
> userInitials lastEventBuffer genieGestureProcessor keyboardInterpreter'
> >> +       classVariableNames: 'CompositionWindowManager DoubleClickTime
> DragThreshold EventStats MinimalWheelDelta NewEventRules NormalCursor
> PasteBuffer SendMouseWheelToKeyboardFocus ShowEvents
> SynthesizeMouseWheelEvents'
> >> -       instanceVariableNames: 'mouseFocus keyboardFocus eventListeners
> mouseListeners keyboardListeners eventCaptureFilters mouseCaptureFilters
> keyboardCaptureFilters mouseClickState mouseOverHandler mouseWheelState
> 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'
> >>         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>>minimumWheelDelta (in category
> 'preferences') -----
> >> + minimumWheelDelta
> >> +       <preference: 'Minimal Mouse Wheel Detection Threshold'
> >> +               categoryList: #(Morphic mouse)
> >> +               description: 'Answer the minimal scrolling units taken
> into account
> >> + Defaults to 120 (See #scrollUnitsPerMouseWheelNotch), corresponding
> to a single mouse wheel notch.
> >> + Use a lower value (20 - See #minimalScrollUnitsPerEvent) if wanting
> smoother scrolling with trackpads.'
> >> +               type: #Number>
> >> +       ^MinimalWheelDelta ifNil: [MouseWheelEvent
> scrollUnitsPerMouseWheelNotch].!
> >>
> >> Item was added:
> >> + ----- Method: HandMorph class>>minimumWheelDelta: (in category
> 'preferences') -----
> >> + minimumWheelDelta: anInteger
> >> +       MinimalWheelDelta := anInteger ifNotNil: [anInteger
> >> +               clampLow: MouseWheelEvent minimalScrollUnitsPerEvent
> >> +               high: MouseWheelEvent scrollUnitsPerMouseWheelNotch]!
> >>
> >> Item was changed:
> >>   ----- Method: HandMorph>>generateMouseWheelEvent: (in category
> 'private events') -----
> >>   generateMouseWheelEvent: evtBuf
> >>         "Generate the appropriate mouse wheel event for the given raw
> event buffer"
> >>
> >> +       | buttons modifiers deltaX deltaY stamp nextEvent |
> >> -       | buttons modifiers deltaX deltaY stamp |
> >>         stamp := evtBuf second.
> >>         stamp = 0 ifTrue: [stamp := Time eventMillisecondClock].
> >>         deltaX := evtBuf third.
> >>         deltaY := evtBuf fourth.
> >> +       buttons := evtBuf fifth.
> >> +       modifiers := evtBuf sixth.
> >> +       [(deltaX abs + deltaY abs < self class minimumWheelDelta)
> >> +                       and: [(nextEvent := Sensor peekEvent) notNil
> >> +                       and: [nextEvent first = evtBuf first
> >> +                       and: [nextEvent fifth = evtBuf fifth
> >> +                       and: [nextEvent sixth = evtBuf sixth]
> >> +                       and: [nextEvent third isZero = evtBuf third
> isZero "both horizontal or vertical"]]]]]
> >> +               whileTrue:
> >> +                       ["nextEvent is similar.  Remove it from the
> queue, and check the next."
> >> +                       nextEvent := Sensor nextEvent.
> >> +                       deltaX := deltaX + nextEvent third.
> >> +                       deltaY := deltaY + nextEvent fourth].
> >> -       modifiers := evtBuf fifth.
> >> -       buttons := (modifiers bitShift: 3) bitOr: (lastMouseEvent
> buttons bitAnd: 7).
> >>         ^ MouseWheelEvent new
> >>                 setType: #mouseWheel
> >>                 position: self position
> >>                 delta: deltaX at deltaY
> >> -               direction: 2r0000
> >>                 buttons: buttons
> >>                 hand: self
> >>                 stamp: stamp!
> >>
> >> Item was changed:
> >>   ----- Method: HandMorph>>generateMouseWheelEvent:direction: (in
> category 'private events') -----
> >>   generateMouseWheelEvent: keystrokeEvent direction: direction
> >>         "Generate the appropriate mouse wheel event from the
> keystrokeEvent. Before calling this, ensure that the control key is pressed.
> >>
> >>         This method can be discarded once the VM produces real mouse
> wheel events."
> >>
> >>         ^ MouseWheelEvent new
> >>                 setType: #mouseWheel
> >>                 position: keystrokeEvent position
> >> +               delta: 0 @ ((direction anyMask: 2r1000 "wheel up")
> ifTrue: [MouseWheelEvent scrollUnitsPerMouseWheelNotch] ifFalse:
> [MouseWheelEvent scrollUnitsPerMouseWheelNotch negated])
> >> -               delta: 0 @ ((direction anyMask: 2r1000 "wheel up")
> ifTrue: [120] ifFalse: [-120])
> >>                 direction: direction
> >>                 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 isMouseWheel ifTrue: [
> >> +               self class sendMouseWheelToKeyboardFocus
> >> +                       ifFalse: [self sendMouseEvent: filteredEvent]
> >> +                       ifTrue: [self sendEvent: filteredEvent focus:
> self keyboardFocus clear: [self keyboardFocus: nil]].
> >> -               mouseWheelState ifNil: [mouseWheelState :=
> MouseWheelState new].
> >> -               mouseWheelState handleEvent: filteredEvent from: self.
> >>                 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:[self sendMouseEvent: filteredEvent].
> >>
> >>         self mouseOverHandler processMouseOver: lastMouseEvent.
> >>         ^ filteredEvent "not necessary but good style -- see Morph >>
> #handleEvent:"    !
> >>
> >> Item was changed:
> >>   ----- Method: Integer>>explorerContents (in category
> '*Morphic-Explorer') -----
> >>   explorerContents
> >>
> >>         ^#(
> >>                 ('hexadecimal' 16)
> >>                 ('octal' 8)
> >>                 ('binary' 2)) collect: [ :each |
> >>                         ObjectExplorerWrapper
> >> +                               with: (self printStringBase: each
> second)
> >> +                               name: each first translated
> >> -                               with: each first translated
> >> -                               name: (self printStringBase: each
> second)
> >>                                 model: self ]!
> >>
> >> Item was added:
> >> + ----- Method: MouseWheelEvent
> class>>convertScrollUnits:intoScrollDelta: (in category 'utility') -----
> >> + convertScrollUnits: scrollUnits intoScrollDelta:
> scrollDeltaPerMouseWheelNotch
> >> +       "Convert the scrolling units provided by the VM into scrolling
> delta (increment) used by Morph.
> >> +       The morph knows how many scroll delta it wants per single wheel
> notch.
> >> +       I know how many scrolling units is generated by a single wheel
> notch."
> >> +
> >> +       ^scrollUnits abs * scrollDeltaPerMouseWheelNotch // self
> scrollUnitsPerMouseWheelNotch max: 1!
> >>
> >> Item was added:
> >> + ----- Method: MouseWheelEvent class>>minimalScrollUnitsPerEvent (in
> category 'constants') -----
> >> + minimalScrollUnitsPerEvent
> >> +       "Answer how many scroll units a single mouse wheel event can
> generate.
> >> +       This reflects a value hardcoded in the VM.
> >> +       The VM aggregate wheel events until this threshold is reached."
> >> +
> >> +       ^20!
> >>
> >> Item was added:
> >> + ----- Method: MouseWheelEvent class>>scrollUnitsPerMouseWheelNotch
> (in category 'constants') -----
> >> + scrollUnitsPerMouseWheelNotch
> >> +       "Answer how many scroll units a single mouse wheel notch does
> generate.
> >> +       This reflects a value hardcoded in the VM.
> >> +       The value is chosen high enough so as to enable:
> >> +       - smoother scrolling on notch-less devices.
> >> +       - while preserving Integer arithmetic
> >> +       Interpretation (scaling) of scrolling units is left to the
> client morphs.
> >> +       Typically, 120 units (1 notch) represents 3 lines of text."
> >> +
> >> +       ^120!
> >>
> >> Item was added:
> >> + ----- Method: MouseWheelEvent>>horizontalScrollDelta: (in category
> 'accessing') -----
> >> + horizontalScrollDelta: scrollDeltaPerMouseWheelNotch
> >> +       "Convert scrolling units into unsigned scrolling increment.
> >> +       The morph knows how many scroll delta it wants per single wheel
> notch.
> >> +       Note that returned increment value is always positive,
> regardless of direction."
> >> +       ^self class convertScrollUnits: delta x intoScrollDelta:
> scrollDeltaPerMouseWheelNotch!
> >>
> >> Item was added:
> >> + ----- Method: MouseWheelEvent>>setDirection (in category
> 'initialization') -----
> >> + setDirection
> >> +       delta x > 0 ifTrue: [self setWheelRight].
> >> +       delta x < 0 ifTrue: [self setWheelLeft].
> >> +
> >> +       delta y > 0 ifTrue: [self setWheelUp].
> >> +       delta y < 0 ifTrue: [self setWheelDown].!
> >>
> >> Item was added:
> >> + ----- Method:
> MouseWheelEvent>>setType:position:delta:buttons:hand:stamp: (in category
> 'private') -----
> >> + setType: evtType position: evtPos delta: evtDelta buttons: evtButtons
> hand: evtHand stamp: stamp
> >> +       type := evtType.
> >> +       position := evtPos.
> >> +       buttons := evtButtons.
> >> +       source := evtHand.
> >> +       wasHandled := false.
> >> +       direction := 2r0000.
> >> +       delta := evtDelta.
> >> +       timeStamp := stamp.
> >> +       self setDirection!
> >>
> >> Item was added:
> >> + ----- Method: MouseWheelEvent>>verticalScrollDelta: (in category
> 'accessing') -----
> >> + verticalScrollDelta: scrollDeltaPerMouseWheelNotch
> >> +       "Convert scrolling units into unsigned scrolling increment.
> >> +       The morph knows how many scroll delta it wants per single wheel
> notch.
> >> +       Note that returned increment value is always positive,
> regardless of direction."
> >> +       ^self class convertScrollUnits: delta y intoScrollDelta:
> scrollDeltaPerMouseWheelNotch!
> >>
> >> Item was removed:
> >> - Object subclass: #MouseWheelState
> >> -       instanceVariableNames: 'currentDelta'
> >> -       classVariableNames: ''
> >> -       poolDictionaries: ''
> >> -       category: 'Morphic-Events'!
> >>
> >> Item was removed:
> >> - ----- Method: MouseWheelState>>handleEvent:from: (in category 'event
> processing') -----
> >> - handleEvent: aMouseWheelEvent from: aHand
> >> -       "Every 120 units, raise the wheel flags for convenient mouse
> wheel programming. We choose not to send multiple mouse-wheel events for
> multiples of 120 because applications can always react to the actual delta
> values if they want to do more scrolling or zooming."
> >> -
> >> -       | sign |
> >> -       currentDelta := currentDelta + aMouseWheelEvent wheelDelta.
> >> -
> >> -       sign := currentDelta sign.
> >> -       currentDelta := currentDelta abs.
> >> -
> >> -       (currentDelta x // 120) > 0 ifTrue: [
> >> -               sign x = 1
> >> -                       ifTrue: [aMouseWheelEvent setWheelRight]
> >> -                       ifFalse: [aMouseWheelEvent setWheelLeft]].
> >> -
> >> -       (currentDelta y // 120) > 0 ifTrue: [
> >> -               sign y = 1
> >> -                       ifTrue: [aMouseWheelEvent setWheelUp]
> >> -                       ifFalse: [aMouseWheelEvent setWheelDown]].
> >> -
> >> -       currentDelta := currentDelta \\ 120.
> >> -       currentDelta := currentDelta * sign.
> >> -
> >> -       "Finally, send the event."
> >> -       HandMorph sendMouseWheelToKeyboardFocus
> >> -               ifFalse: [aHand sendMouseEvent: aMouseWheelEvent]
> >> -               ifTrue: [aHand sendEvent: aMouseWheelEvent focus: aHand
> keyboardFocus clear: [aHand keyboardFocus: nil]].
> >> - !
> >>
> >> Item was removed:
> >> - ----- Method: MouseWheelState>>initialize (in category
> 'initialize-release') -----
> >> - initialize
> >> -
> >> -       super initialize.
> >> -       currentDelta := 0 at 0.!
> >>
> >> Item was changed:
> >>   MorphicModel subclass: #ScrollPane
> >>         instanceVariableNames: 'scrollBar scroller retractableScrollBar
> scrollBarOnLeft getMenuSelector getMenuTitleSelector hasFocus hScrollBar
> hScrollBarPolicy vScrollBarPolicy scrollBarThickness'
> >> +       classVariableNames: 'HorizontalScrollDeltaPerMouseWheelNotch
> UseRetractableScrollBars VerticalScrollDeltaPerMouseWheelNotch'
> >> -       classVariableNames: 'UseRetractableScrollBars'
> >>         poolDictionaries: ''
> >>         category: 'Morphic-Windows'!
> >>
> >>   !ScrollPane commentStamp: 'mk 8/9/2005 10:34' prior: 0!
> >>   The scroller (a transform) of a scrollPane is driven by the
> scrollBar.  The scroll values vary from 0.0, meaning zero offset to 1.0
> meaning sufficient offset such that the bottom of the scrollable material
> appears 3/4 of the way down the pane.  The total distance to achieve this
> range is called the totalScrollRange.
> >>
> >>   Basic clue about utilization of the ScrollPane class is given in:
> >>         ScrollPane example1.
> >>         ScrollPane example2.!
> >>
> >> Item was added:
> >> + ----- Method: ScrollPane
> class>>horizontalScrollDeltaPerMouseWheelNotch (in category 'preferences')
> -----
> >> + horizontalScrollDeltaPerMouseWheelNotch
> >> +
> >> +       <preference: 'horizontal scroll increment per single mouse
> wheel'
> >> +               category: #scrolling
> >> +               description: 'How many horizontal scroll increments
> should be caused in response to a single mouse wheel notch.
> >> + Typically, the scroll panes increment are about 1 character width for
> list and text panes (see #scrollDeltaWidth).
> >> + The default setting is 3 so as to match the most widely used
> convention.'
> >> +               type: #Number>
> >> +       ^ HorizontalScrollDeltaPerMouseWheelNotch ifNil: [3]!
> >>
> >> Item was added:
> >> + ----- Method: ScrollPane
> class>>horizontalScrollDeltaPerMouseWheelNotch: (in category 'preferences')
> -----
> >> + horizontalScrollDeltaPerMouseWheelNotch: anIntegerOrNil
> >> +
> >> +       HorizontalScrollDeltaPerMouseWheelNotch := anIntegerOrNil!
> >>
> >> Item was added:
> >> + ----- Method: ScrollPane class>>verticalScrollDeltaPerMouseWheelNotch
> (in category 'preferences') -----
> >> + verticalScrollDeltaPerMouseWheelNotch
> >> +
> >> +       <preference: 'vertical scroll increment per single mouse wheel'
> >> +               category: #scrolling
> >> +               description: 'How many vertical scroll increments
> should be caused in response to a single mouse wheel notch.
> >> + Typically, the scroll panes increment are one line height for list
> and text panes (see #scrollDeltaHeight).
> >> + The default setting is 3 so as to match the most widely used
> convention.'
> >> +               type: #Number>
> >> +       ^ VerticalScrollDeltaPerMouseWheelNotch ifNil: [3]!
> >>
> >> Item was added:
> >> + ----- Method: ScrollPane
> class>>verticalScrollDeltaPerMouseWheelNotch: (in category 'preferences')
> -----
> >> + verticalScrollDeltaPerMouseWheelNotch: anIntegerOrNil
> >> +
> >> +       VerticalScrollDeltaPerMouseWheelNotch := anIntegerOrNil!
> >>
> >> Item was changed:
> >>   ----- Method: ScrollPane>>mouseWheel: (in category 'event handling')
> -----
> >>   mouseWheel: evt
> >>
> >> +       evt isWheelUp ifTrue: [scrollBar scrollUp: (evt
> verticalScrollDelta: self class verticalScrollDeltaPerMouseWheelNotch)].
> >> +       evt isWheelDown ifTrue: [scrollBar scrollDown: (evt
> verticalScrollDelta: self class verticalScrollDeltaPerMouseWheelNotch)].
> >> +       evt isWheelLeft ifTrue: [hScrollBar scrollUp: (evt
> horizontalScrollDelta: self class verticalScrollDeltaPerMouseWheelNotch)].
> >> +       evt isWheelRight ifTrue: [hScrollBar scrollDown: (evt
> horizontalScrollDelta: self class verticalScrollDeltaPerMouseWheelNotch)].!
> >> -       evt isWheelUp ifTrue: [scrollBar scrollUp: 3].
> >> -       evt isWheelDown ifTrue: [scrollBar scrollDown: 3].!
> >>
> >> Item was changed:
> >>   ----- Method: TextEditor>>hasMultipleLinesSelected (in category
> 'typing support') -----
> >>   hasMultipleLinesSelected
> >> +       ^ self selection includesAnyOf: CharacterSet crlf!
> >> -
> >> -       ^ self hasSelection and: [self startBlock top < self stopBlock
> top]!
> >>
> >> Item was changed:
> >> + (PackageInfo named: 'Morphic') postscript: '''Set a smoother
> scrolling, especially useful for trackpads"
> >> + HandMorph minimumWheelDelta: 20.
> >> + Smalltalk sendMouseWheelEvents: true.'!
> >> - (PackageInfo named: 'Morphic') postscript: 'PluggableListMorph
> allSubInstancesDo: [:m |
> >> -       m scroller layoutPolicy: TableLayout new.
> >> -       m listMorph
> >> -               cellPositioning: #leftCenter;
> >> -               cellInset: 3 at 0;
> >> -               vResizing: #shrinkWrap;
> >> -               removeProperty: #errorOnDraw. "Just in case."
> >> -       m updateList.
> >> -       m hScrollBarPolicy: #never].
> >> - '!
> >>
> >>
> >
>
>
>
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://lists.squeakfoundation.org/pipermail/squeak-dev/attachments/20200306/0beb2dc9/attachment-0001.html>


More information about the Squeak-dev mailing list