The Trunk: Morphic-mt.925.mcz

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

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

Name: Morphic-mt.925
Author: mt
Time: 25 April 2015, 10:28:04.156 am
UUID: a6424dc5-e32e-e444-8ffe-a5d1a3ad0deb
Ancestors: Morphic-kfr.924

Performance improved about 10 to 1000x for layouting of scrollpanes and their subclasses -- depending on methods accessed.

How?
- instance variables for scrollbar policies instead of using the property dictionary of morphs
- instance variable for scroll bar thickness instead of querying Preferences dictionary over and over again
- caching minimum extent instead of calculating it in #minWidth and #minHeight
- improved implementation of #innerBounds
- avoid enforcing #minExtent when changing the #extent: (now only enforced within a layout via #layoutBounds:)

Note #scrollBarThickness does not yet use instVar because I will modify the update map first to migrate open tools properly.

=============== Diff against Morphic-kfr.924 ===============

Item was removed:
- ----- Method: PluggableListMorph>>resizeScrollBars (in category 'scroll cache') -----
- resizeScrollBars
-
-
- (self extent = self defaultExtent)
- ifTrue:[
- WorldState addDeferredUIMessage:
- [ self  vResizeScrollBar; resizeScroller; hResizeScrollBar]
- ]
- ifFalse:[self vResizeScrollBar; hResizeScrollBar].
-
-
- !

Item was removed:
- ----- Method: PluggableTextMorph>>minScrollbarExtent (in category 'geometry') -----
- minScrollbarExtent
- "We never have a horizontal scroll bar if we wrap text."
-
- ^ (textMorph notNil and: [textMorph isAutoFit])
- ifTrue: [((self valueOfProperty: #noVScrollBarPlease ifAbsent: [false])
- ifTrue:[0@0] ifFalse:[scrollBar minExtent])]
- ifFalse: [super minScrollbarExtent]!

Item was added:
+ ----- Method: PluggableTextMorph>>minScrollbarHeight (in category 'geometry') -----
+ minScrollbarHeight
+ "We never have a horizontal scroll bar if we wrap text."
+
+ ^ (textMorph notNil and: [textMorph isAutoFit])
+ ifTrue: [self vScrollBarPolicy == #never
+ ifTrue:[0] ifFalse:[scrollBar minHeight]]
+ ifFalse: [super minScrollbarHeight]!

Item was added:
+ ----- Method: PluggableTextMorph>>minScrollbarWidth (in category 'geometry') -----
+ minScrollbarWidth
+ "We never have a horizontal scroll bar if we wrap text."
+
+ ^ (textMorph notNil and: [textMorph isAutoFit])
+ ifTrue: [(retractableScrollBar or: [self vScrollBarPolicy == #never])
+ ifTrue:[0] ifFalse:[self scrollBarThickness]]
+ ifFalse: [super minScrollbarWidth]!

Item was changed:
  MorphicModel subclass: #ScrollPane
+ instanceVariableNames: 'scrollBar scroller retractableScrollBar scrollBarOnLeft getMenuSelector getMenuTitleSelector hasFocus hScrollBar lockOffset hScrollBarPolicy vScrollBarPolicy scrollBarThickness'
- instanceVariableNames: 'scrollBar scroller retractableScrollBar scrollBarOnLeft getMenuSelector getMenuTitleSelector scrollBarHidden hasFocus hScrollBar lockOffset'
  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>>scrollBarThickness (in category 'defaults') -----
+ scrollBarThickness
+
+ ^ Preferences scrollBarsNarrow
+ ifTrue: [10]
+ ifFalse: [14]!

Item was changed:
+ ----- Method: ScrollPane>>adoptPaneColor: (in category 'accessing') -----
- ----- Method: ScrollPane>>adoptPaneColor: (in category 'access') -----
  adoptPaneColor: paneColor
  super adoptPaneColor: paneColor.
 
  "May not be in the hierarchy at the moment."
  scrollBar adoptPaneColor: paneColor.
  hScrollBar adoptPaneColor: paneColor.
 
  paneColor ifNotNil: [:c | self borderColor: (c adjustBrightness: -0.3)].!

Item was changed:
+ ----- Method: ScrollPane>>alwaysShowHScrollBar (in category 'accessing options') -----
- ----- Method: ScrollPane>>alwaysShowHScrollBar (in category 'access options') -----
  alwaysShowHScrollBar
 
+ self hScrollBarPolicy: #always.
- self setProperty: #hScrollBarAlways toValue: true.
- self setProperty: #noHScrollBarPlease toValue: false.
-
  self hHideOrShowScrollBar.
  !

Item was changed:
  ----- Method: ScrollPane>>alwaysShowHScrollBar: (in category 'DEPRECATED') -----
  alwaysShowHScrollBar: bool
  self flag: #deprecated.
  self setProperty: #hScrollBarAlways toValue: bool.
+
+ bool
+ ifTrue: [self hScrollBarPolicy: #always]
+ ifFalse: [self hScrollBarPolicy: #whenNeeded].
+
  self hHideOrShowScrollBar.
  !

Item was changed:
+ ----- Method: ScrollPane>>alwaysShowScrollBars (in category 'accessing options') -----
- ----- Method: ScrollPane>>alwaysShowScrollBars (in category 'access options') -----
  alwaysShowScrollBars
 
  self
  alwaysShowHScrollBar;
  alwaysShowVScrollBar.
  !

Item was changed:
+ ----- Method: ScrollPane>>alwaysShowVScrollBar (in category 'accessing options') -----
- ----- Method: ScrollPane>>alwaysShowVScrollBar (in category 'access options') -----
  alwaysShowVScrollBar
 
+ self vScrollBarPolicy: #always.
- self setProperty: #vScrollBarAlways toValue: true.
- self setProperty: #noVScrollBarPlease toValue: false.
-
  self vHideOrShowScrollBar.
  !

Item was changed:
  ----- Method: ScrollPane>>alwaysShowVScrollBar: (in category 'DEPRECATED') -----
  alwaysShowVScrollBar: bool
 
  self flag: #deprecated.
 
  self setProperty: #vScrollBarAlways toValue: bool.
+
+ bool
+ ifTrue: [self vScrollBarPolicy: #always]
+ ifFalse: [self vScrollBarPolicy: #whenNeeded].
+
  self vHideOrShowScrollBar.
  !

Item was changed:
+ ----- Method: ScrollPane>>canBeEncroached (in category 'support') -----
- ----- Method: ScrollPane>>canBeEncroached (in category 'testing') -----
  canBeEncroached
  "For support of the smartHorizontalSplitters preference."
  ^ scrollBar isInWorld not!

Item was changed:
  ----- Method: ScrollPane>>containsPoint: (in category 'geometry testing') -----
  containsPoint: aPoint
 
  (super containsPoint: aPoint) ifTrue: [^ true].
 
  "Also include v scrollbar when it is extended..."
+ ((retractableScrollBar and: [self vIsScrollbarShowing]) and:
- ((retractableScrollBar and: [submorphs includes: scrollBar]) and:
  [scrollBar containsPoint: aPoint])
  ifTrue:[ ^true ].
 
  "Also include hScrollbar when it is extended..."
+ ((retractableScrollBar and: [self hIsScrollbarShowing]) and:
+ [hScrollBar containsPoint: aPoint])
+ ifTrue: [ ^true ].
+
+ ^ false
- ^(retractableScrollBar and: [self hIsScrollbarShowing]) and:
- [hScrollBar containsPoint: aPoint]
  !

Item was changed:
  ----- Method: ScrollPane>>extent: (in category 'geometry') -----
  extent: aPoint
 
  self handleResizeAction: [
+ (bounds extent closeTo: aPoint)
- | newExtent |
- newExtent := aPoint max: self minScrollbarExtent.
- (bounds extent closeTo: newExtent)
  ifTrue: [false]
  ifFalse: [
+ super extent: aPoint.
- super extent: newExtent.
  super layoutChanged.
  true]].!

Item was changed:
  ----- Method: ScrollPane>>extentToFit (in category 'geometry') -----
  extentToFit
  "Resize scroll pane to exactly fit its contents."
 
  | offset |
  offset := 0@0.
+ (retractableScrollBar not and: [self vScrollBarPolicy == #always])
- (retractableScrollBar not and: [self hasProperty: #vScrollBarAlways])
  ifTrue: [offset := (self scrollBarThickness - self borderWidth) @ offset y].
+ (retractableScrollBar not and: [self hScrollBarPolicy == #always])
- (retractableScrollBar not and: [self hasProperty: #hScrollBarAlways])
  ifTrue: [offset := offset x @ (self scrollBarThickness - self borderWidth)].
 
  ^ scroller submorphBounds extent + offset + (2* (self borderWidth @ self borderWidth))!

Item was changed:
+ ----- Method: ScrollPane>>flatColoredScrollBarLook (in category 'accessing') -----
- ----- Method: ScrollPane>>flatColoredScrollBarLook (in category 'access') -----
  flatColoredScrollBarLook
  "Currently only show the flat (not rounded) + colored-to-match-window scrollbar look when inboard."
  ^ retractableScrollBar not or: [ScrollBar alwaysShowFlatScrollbarForAlternativeLook]
  !

Item was changed:
+ ----- Method: ScrollPane>>hExtraScrollRange (in category 'geometry ranges') -----
- ----- Method: ScrollPane>>hExtraScrollRange (in category 'geometry') -----
  hExtraScrollRange
  "Return the amount of extra blank space to include below the bottom of the scroll content."
  ^ 0
  !

Item was changed:
+ ----- Method: ScrollPane>>hInitScrollBarTEMPORARY (in category 'DEPRECATED') -----
- ----- Method: ScrollPane>>hInitScrollBarTEMPORARY (in category 'initialization') -----
  hInitScrollBarTEMPORARY
  "This is called lazily before the hScrollBar is accessed in a couple of places. It is provided to transition old ScrollPanes lying around that do not have an hScrollBar. Once it has been in the image for awhile, and all ScrollPanes have an hScrollBar, this method and it's references can be removed. "
 
  "Temporary method for filein of changeset"
  hScrollBar ifNil:
  [hScrollBar := ScrollBar new model: self slotName: 'hScrollBar'.
  hScrollBar borderWidth: 1; borderColor: Color black.
  self
  resizeScrollBars;
  setScrollDeltas;
  hideOrShowScrollBars].
  !

Item was changed:
  ----- Method: ScrollPane>>hIsScrollbarNeeded (in category 'scrolling') -----
  hIsScrollbarNeeded
  "Return whether the horz scrollbar is needed"
 
  "Don't do anything with the retractable scrollbar unless we have focus"
  retractableScrollBar & self hasFocus not ifTrue: [^false].
 
  "Don't show it if we were told not to."
+ self hScrollBarPolicy == #never ifTrue: [^false].
- (self valueOfProperty: #noHScrollBarPlease ifAbsent: [false]) ifTrue: [^false].
 
  "Always show it if we were told to"
+ self hScrollBarPolicy == #always ifTrue: [^true].
- (self valueOfProperty: #hScrollBarAlways ifAbsent: [false]) ifTrue: [^true].
 
  ^self hIsScrollable
  !

Item was changed:
+ ----- Method: ScrollPane>>hLeftoverScrollRange (in category 'geometry ranges') -----
- ----- Method: ScrollPane>>hLeftoverScrollRange (in category 'geometry') -----
  hLeftoverScrollRange
  "Return the entire scrolling range minus the currently viewed area."
 
  ^ scroller hasSubmorphs
  ifFalse: [0]
  ifTrue: [self hTotalScrollRange - scroller width max: 0]
  !

Item was changed:
+ ----- Method: ScrollPane>>hMargin (in category 'accessing') -----
- ----- Method: ScrollPane>>hMargin (in category 'access') -----
  hMargin
  "pixels of whitespace at to the left of the scroller when the hScrollBar offset is 0"
  ^0
  !

Item was changed:
  ----- Method: ScrollPane>>hResizeScrollBar (in category 'geometry') -----
  hResizeScrollBar
 
  | topLeft h border offset |
+ self hScrollBarPolicy == #never ifTrue: [^self].
-
- "TEMPORARY: IF OLD SCROLLPANES LYING AROUND THAT DON'T HAVE A hScrollBar, INIT THEM"
- hScrollBar ifNil: [ self hInitScrollBarTEMPORARY].
-
- (self valueOfProperty: #noHScrollBarPlease ifAbsent: [false]) ifTrue: [^self].
  bounds ifNil: [ self fullBounds ].
 
  h := self scrollBarThickness.
  border := borderWidth.
  offset := (scrollBarOnLeft and: [self vIsScrollbarShowing and: [retractableScrollBar not]])
  ifTrue: [h]
  ifFalse: [0].
 
  topLeft := retractableScrollBar
  ifTrue: [bounds bottomLeft + (offset @ border negated)]
  ifFalse: [bounds bottomLeft + (offset @ h negated)].
 
+ hScrollBar bounds: (topLeft extent: self hScrollBarWidth@ h)!
- hScrollBar bounds: (topLeft extent: self hScrollBarWidth@ h)
- !

Item was changed:
+ ----- Method: ScrollPane>>hScrollBar (in category 'accessing') -----
- ----- Method: ScrollPane>>hScrollBar (in category 'access') -----
  hScrollBar
  ^ hScrollBar!

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

Item was added:
+ ----- Method: ScrollPane>>hScrollBarPolicy: (in category 'accessing') -----
+ hScrollBarPolicy: aSymbol
+ "#always, #never, #whenNeeded"
+
+ hScrollBarPolicy := aSymbol.!

Item was changed:
+ ----- Method: ScrollPane>>hTotalScrollRange (in category 'geometry ranges') -----
- ----- Method: ScrollPane>>hTotalScrollRange (in category 'geometry') -----
  hTotalScrollRange
  "Return the entire scrolling range."
  ^ self hUnadjustedScrollRange + self hExtraScrollRange + self hMargin
  !

Item was changed:
+ ----- Method: ScrollPane>>hUnadjustedScrollRange (in category 'geometry ranges') -----
- ----- Method: ScrollPane>>hUnadjustedScrollRange (in category 'geometry') -----
  hUnadjustedScrollRange
  "Return the width extent of the receiver's submorphs."
 
  | submorphBounds |
  submorphBounds := scroller localSubmorphBounds ifNil: [^ 0].
  ^ submorphBounds right
  !

Item was changed:
+ ----- Method: ScrollPane>>hasFocus (in category 'accessing') -----
- ----- Method: ScrollPane>>hasFocus (in category 'access') -----
  hasFocus
  "hasFocus is currently set by mouse enter/leave events.
  This inst var should probably be moved up to a higher superclass."
 
  ^ hasFocus ifNil: [false]!

Item was changed:
+ ----- Method: ScrollPane>>hideHScrollBarIndefinitely (in category 'accessing options') -----
- ----- Method: ScrollPane>>hideHScrollBarIndefinitely (in category 'access options') -----
  hideHScrollBarIndefinitely
  "Get rid of scroll bar for short panes that don't want it shown."
 
+ self hScrollBarPolicy: #never.
- self setProperty: #noHScrollBarPlease toValue: true.
- self setProperty: #hScrollBarAlways toValue: false.
-
  self hHideOrShowScrollBar.
  !

Item was changed:
  ----- Method: ScrollPane>>hideHScrollBarIndefinitely: (in category 'DEPRECATED') -----
  hideHScrollBarIndefinitely: bool
  "Get rid of scroll bar for short panes that don't want it shown."
 
  self flag: #deprecated.
 
  self setProperty: #noHScrollBarPlease toValue: bool.
+
+ bool
+ ifTrue: [self hScrollBarPolicy: #never]
+ ifFalse: [self hScrollBarPolicy: #whenNeeded].
+
  self hHideOrShowScrollBar.
  !

Item was changed:
+ ----- Method: ScrollPane>>hideScrollBarsIndefinitely (in category 'accessing options') -----
- ----- Method: ScrollPane>>hideScrollBarsIndefinitely (in category 'access options') -----
  hideScrollBarsIndefinitely
 
  self
  hideVScrollBarIndefinitely;
  hideHScrollBarIndefinitely.!

Item was changed:
+ ----- Method: ScrollPane>>hideVScrollBarIndefinitely (in category 'accessing options') -----
- ----- Method: ScrollPane>>hideVScrollBarIndefinitely (in category 'access options') -----
  hideVScrollBarIndefinitely
  "Get rid of scroll bar for short panes that don't want it shown."
 
+ self vScrollBarPolicy: #never.
- self setProperty: #noVScrollBarPlease toValue: true.
- self setProperty: #vScrollBarAlways toValue: false.
-
  self vHideOrShowScrollBar.
  !

Item was changed:
  ----- Method: ScrollPane>>hideVScrollBarIndefinitely: (in category 'DEPRECATED') -----
  hideVScrollBarIndefinitely: bool
  "Get rid of scroll bar for short panes that don't want it shown."
 
  self flag: #deprecated.
 
  self setProperty: #noVScrollBarPlease toValue: bool.
+
+ bool
+ ifTrue: [self vScrollBarPolicy: #never]
+ ifFalse: [self vScrollBarPolicy: #whenNeeded].
+
  self vHideOrShowScrollBar.
  !

Item was changed:
  ----- Method: ScrollPane>>initializePreferences (in category 'initialization') -----
  initializePreferences
  "initialize the receiver's Preferences"
+
  retractableScrollBar := self class useRetractableScrollBars.
  scrollBarOnLeft := (Preferences valueOfFlag: #scrollBarsOnRight) not.
+ scrollBarThickness := self class scrollBarThickness.
 
+ Preferences alwaysShowVScrollbar
+ ifTrue: [ self vScrollBarPolicy: #always ]
+ ifFalse: [ self vScrollBarPolicy: #whenNeeded ].
+
+ Preferences alwaysHideHScrollbar
+ ifTrue:[ self hScrollBarPolicy: #never ]
+ ifFalse: [ Preferences alwaysShowHScrollbar
+ ifTrue: [ self hScrollBarPolicy: #always ]
+ ifFalse: [ self hScrollBarPolicy: #whenNeeded ]].!
-
- !

Item was changed:
  ----- Method: ScrollPane>>initializeScrollBars (in category 'initialization') -----
  initializeScrollBars
+ "Initialize vertical and horizontal scroll bars."
- "initialize the receiver's scrollBar"
 
  (scrollBar := ScrollBar on: self getValue: nil setValue: #vScrollBarValue:)
  menuSelector: #vScrollBarMenuButtonPressed:;
  orientation: #vertical.
  (hScrollBar := ScrollBar on: self getValue: nil setValue: #hScrollBarValue:)
  menuSelector: #hScrollBarMenuButtonPressed:;
  orientation: #horizontal.
 
  ""
  scroller := TransformMorph new color: Color transparent.
  scroller offset: 0 @ 0.
  self addMorph: scroller.
  ""
  scrollBar initializeEmbedded: retractableScrollBar not.
  hScrollBar initializeEmbedded: retractableScrollBar not.
  retractableScrollBar ifFalse:
  [self
  addMorph: scrollBar;
  addMorph: hScrollBar].
+ self updateMinimumExtent.!
-
- Preferences alwaysShowVScrollbar ifTrue:
- [ self alwaysShowVScrollBar ].
-
- Preferences alwaysHideHScrollbar
- ifTrue:[self hideHScrollBarIndefinitely ]
- ifFalse: [
- Preferences alwaysShowHScrollbar ifTrue:
- [ self alwaysShowHScrollBar ]].!

Item was changed:
  ----- Method: ScrollPane>>innerBounds (in category 'geometry') -----
  innerBounds
+
+ | inner bottomOffset leftOffset rightOffset |
+ (retractableScrollBar or: [self vIsScrollbarShowing not])
+ ifTrue: [leftOffset := rightOffset := 0]
+ ifFalse: [
+ scrollBarOnLeft
+ ifTrue: [
+ leftOffset := self scrollBarThickness - self borderWidth.
+ rightOffset := 0.]
+ ifFalse: [
+ leftOffset := 0.
+ rightOffset := self scrollBarThickness - self borderWidth]].
+
+ (retractableScrollBar or: [self hIsScrollbarShowing not])
+ ifTrue: [bottomOffset := 0]
+ ifFalse: [bottomOffset := self scrollBarThickness - self borderWidth].
+
- | inner |
  inner := super innerBounds.
+ ^ (inner left + leftOffset) @ (inner top "+ topOffset")
+ corner: (inner right - rightOffset) @ (inner bottom - bottomOffset)!
- retractableScrollBar | (submorphs includes: scrollBar) not ifFalse:[
- inner := (scrollBarOnLeft
- ifTrue: [scrollBar right @ inner top corner: inner bottomRight]
- ifFalse: [inner topLeft corner: scrollBar left @ inner bottom])
- ].
- (retractableScrollBar | self hIsScrollbarShowing not)
- ifTrue: [^ inner]
- ifFalse: [^ inner topLeft corner: (inner bottomRight - (0@(self scrollBarThickness - self borderWidth)))].
- !

Item was changed:
+ ----- Method: ScrollPane>>isAScrollbarShowing (in category 'DEPRECATED') -----
- ----- Method: ScrollPane>>isAScrollbarShowing (in category 'geometry testing') -----
  isAScrollbarShowing
  "Return true if a either retractable scroll bar is currently showing"
+
+ self flag: #deprectaed. "mt: Use #isAnyScrollbarShowing"
  retractableScrollBar ifFalse:[^true].
  ^self hIsScrollbarShowing or: [self vIsScrollbarShowing]
  !

Item was added:
+ ----- Method: ScrollPane>>isAnyScrollbarShowing (in category 'geometry testing') -----
+ isAnyScrollbarShowing
+
+ ^ self hIsScrollbarShowing or: [self vIsScrollbarShowing]
+ !

Item was changed:
+ ----- Method: ScrollPane>>isAutoFit (in category 'accessing') -----
- ----- Method: ScrollPane>>isAutoFit (in category 'access') -----
  isAutoFit
  "Does this scroll pane modifies the extent of its scrollable content when it resizes itself to avoid, for example, a horizontal or vertical scrollbar?"
 
  ^ false!

Item was changed:
+ ----- Method: ScrollPane>>isScrolledFromTop (in category 'support') -----
- ----- Method: ScrollPane>>isScrolledFromTop (in category 'geometry testing') -----
  isScrolledFromTop
  "Have the contents of the pane been scrolled, so that the top of the contents are not visible?"
+ ^ self vIsScrolled
- ^scroller offset y > 0
  !

Item was removed:
- ----- Method: ScrollPane>>minHeight (in category 'geometry') -----
- minHeight
-
- ^ super minHeight max: self minScrollbarExtent y!

Item was removed:
- ----- Method: ScrollPane>>minScrollbarExtent (in category 'geometry') -----
- minScrollbarExtent
- "Answer the minimum extent occupied by the receiver..
- It is assumed the if the receiver is sized to its minimum both scrollbars will be used (and visible) unless they have been turned off explicitly.
- This makes the behaviour also more predictable."
- | vMin hMin |
-
- vMin :=((self valueOfProperty: #noVScrollBarPlease ifAbsent: [false])
- ifTrue:[0@0] ifFalse:[self scrollBarThickness @ scrollBar minExtent y]).
- hMin := ((self valueOfProperty: #noHScrollBarPlease ifAbsent: [false])
- ifTrue:[0@0] ifFalse:[hScrollBar minExtent x @ self scrollBarThickness]).
-
- ^ retractableScrollBar
- ifTrue: [hMin x @ vMin y]
- ifFalse: [hMin + vMin "They both need space."]!

Item was added:
+ ----- Method: ScrollPane>>minScrollbarHeight (in category 'layout') -----
+ minScrollbarHeight
+ "Answer the minimum extent occupied by the receiver..
+ It is assumed the if the receiver is sized to its minimum both scrollbars will be used (and visible) unless they have been turned off explicitly.
+ This makes the behaviour also more predictable."
+
+ ^ (self vScrollBarPolicy == #never
+ ifTrue: [0]
+ ifFalse: [scrollBar minHeight])
+ + (retractableScrollBar
+ ifTrue: [0]
+ ifFalse: [self hScrollBarPolicy == #never
+ ifTrue:[0]
+ ifFalse:[self scrollBarThickness]])!

Item was added:
+ ----- Method: ScrollPane>>minScrollbarWidth (in category 'layout') -----
+ minScrollbarWidth
+ "Answer the minimum extent occupied by the receiver..
+ It is assumed the if the receiver is sized to its minimum both scrollbars will be used (and visible) unless they have been turned off explicitly.
+ This makes the behaviour also more predictable."
+
+ ^ (self hScrollBarPolicy == #never
+ ifTrue: [0]
+ ifFalse: [hScrollBar minWidth])
+ + (retractableScrollBar
+ ifTrue: [0]
+ ifFalse: [self vScrollBarPolicy == #never
+ ifTrue:[0]
+ ifFalse:[self scrollBarThickness]])!

Item was removed:
- ----- Method: ScrollPane>>minWidth (in category 'geometry') -----
- minWidth
-
- ^ super minWidth max: self minScrollbarExtent x!

Item was changed:
+ ----- Method: ScrollPane>>retractable: (in category 'accessing retractable') -----
- ----- Method: ScrollPane>>retractable: (in category 'menu') -----
  retractable: aBoolean
  retractableScrollBar == aBoolean ifFalse: [self retractableOrNot "toggles it"]!

Item was changed:
+ ----- Method: ScrollPane>>retractableOrNot (in category 'accessing retractable') -----
- ----- Method: ScrollPane>>retractableOrNot (in category 'menu') -----
  retractableOrNot
  "Change scroll bar operation"
 
  retractableScrollBar := retractableScrollBar not.
  retractableScrollBar
  ifTrue: [
- scrollBar disableTableLayout: true.
- hScrollBar disableTableLayout: true.
  self removeMorph: scrollBar; removeMorph: hScrollBar]
  ifFalse: [(submorphs includes: scrollBar)
  ifFalse:
  [self privateAddMorph: scrollBar atIndex: 1.
  self privateAddMorph: hScrollBar atIndex: 1]].
+ self
+ updateMinimumExtent;
+ resizeScrollBars;
+ resizeScroller;
+ hideOrShowScrollBars.!
- self extent: self extent.!

Item was changed:
+ ----- Method: ScrollPane>>retractableScrollBar (in category 'accessing retractable') -----
- ----- Method: ScrollPane>>retractableScrollBar (in category 'access') -----
  retractableScrollBar
  ^ retractableScrollBar!

Item was changed:
+ ----- Method: ScrollPane>>scrollBarFills: (in category 'support') -----
- ----- Method: ScrollPane>>scrollBarFills: (in category 'geometry testing') -----
  scrollBarFills: aRectangle
  "Return true if a flop-out scrollbar fills the rectangle"
 
  retractableScrollBar ifFalse:[^false].
 
  ((submorphs includes: scrollBar) and: [scrollBar bounds containsRect: aRectangle])
  ifTrue:[ ^true ].
  ^((submorphs includes: hScrollBar) and: [hScrollBar bounds containsRect: aRectangle])
  !

Item was changed:
+ ----- Method: ScrollPane>>scrollBarOnLeft (in category 'accessing') -----
- ----- Method: ScrollPane>>scrollBarOnLeft (in category 'access') -----
  scrollBarOnLeft
  ^ scrollBarOnLeft!

Item was changed:
+ ----- Method: ScrollPane>>scrollBarOnLeft: (in category 'accessing') -----
- ----- Method: ScrollPane>>scrollBarOnLeft: (in category 'menu') -----
  scrollBarOnLeft: aBoolean
  scrollBarOnLeft := aBoolean.
  self extent: self extent!

Item was changed:
+ ----- Method: ScrollPane>>scrollBarThickness (in category 'accessing') -----
- ----- Method: ScrollPane>>scrollBarThickness (in category 'geometry') -----
  scrollBarThickness
  "Includes border"
- | result |
- result := Preferences scrollBarsNarrow
- ifTrue: [10]
- ifFalse: [14].
-
- self flatColoredScrollBarLook
- ifFalse: [result := result + 2].
 
+ "^ scrollBarThickness"
+ ^ self class scrollBarThickness!
- ^ result!

Item was added:
+ ----- Method: ScrollPane>>scrollBarThickness: (in category 'accessing') -----
+ scrollBarThickness: anInteger
+
+ scrollBarThickness := anInteger.
+ self updateMinimumExtent.!

Item was changed:
+ ----- Method: ScrollPane>>scroller (in category 'accessing') -----
- ----- Method: ScrollPane>>scroller (in category 'access') -----
  scroller
  ^ scroller!

Item was changed:
+ ----- Method: ScrollPane>>scroller: (in category 'accessing') -----
- ----- Method: ScrollPane>>scroller: (in category 'access') -----
  scroller: aTransformMorph
  scroller ifNotNil:[scroller delete].
  scroller := aTransformMorph.
  self addMorph: scroller.
  self resizeScroller.!

Item was changed:
+ ----- Method: ScrollPane>>showHScrollBarOnlyWhenNeeded (in category 'accessing options') -----
- ----- Method: ScrollPane>>showHScrollBarOnlyWhenNeeded (in category 'access options') -----
  showHScrollBarOnlyWhenNeeded
 
+ self hScrollBarPolicy: #whenNeeded.
- self setProperty: #noHScrollBarPlease toValue: false.
- self setProperty: #hScrollBarAlways toValue: false.
-
  self hHideOrShowScrollBar.
  !

Item was changed:
  ----- Method: ScrollPane>>showHScrollBarOnlyWhenNeeded: (in category 'DEPRECATED') -----
  showHScrollBarOnlyWhenNeeded: bool
  "Get rid of scroll bar for short panes that don't want it shown."
 
  self flag: #deprecated.
 
  self setProperty: #noHScrollBarPlease toValue: bool not.
  self setProperty: #hScrollBarAlways toValue: bool not.
 
+ bool
+ ifTrue: [self hScrollBarPolicy: #whenNeeded]
+ ifFalse: [self hScrollBarPolicy: #never].
+
  self hHideOrShowScrollBar.
  !

Item was changed:
+ ----- Method: ScrollPane>>showScrollBarsOnlyWhenNeeded (in category 'accessing options') -----
- ----- Method: ScrollPane>>showScrollBarsOnlyWhenNeeded (in category 'access options') -----
  showScrollBarsOnlyWhenNeeded
 
  self
  showHScrollBarOnlyWhenNeeded;
  showVScrollBarOnlyWhenNeeded.
  !

Item was changed:
+ ----- Method: ScrollPane>>showVScrollBarOnlyWhenNeeded (in category 'accessing options') -----
- ----- Method: ScrollPane>>showVScrollBarOnlyWhenNeeded (in category 'access options') -----
  showVScrollBarOnlyWhenNeeded
  "Get rid of scroll bar for short panes that don't want it shown."
 
+ self vScrollBarPolicy: #whenNeeded.
- self setProperty: #noVScrollBarPlease toValue: false.
- self setProperty: #vScrollBarAlways toValue: false.
-
  self vHideOrShowScrollBar.
  !

Item was changed:
  ----- Method: ScrollPane>>showVScrollBarOnlyWhenNeeded: (in category 'DEPRECATED') -----
  showVScrollBarOnlyWhenNeeded: bool
  "Get rid of scroll bar for short panes that don't want it shown."
 
  self flag: #deprecated.
 
  self setProperty: #noVScrollBarPlease toValue: bool not.
  self setProperty: #vScrollBarAlways toValue: bool not.
+
+ bool
+ ifTrue: [self vScrollBarPolicy: #whenNeeded]
+ ifFalse: [self vScrollBarPolicy: #never].
+
  self vHideOrShowScrollBar.
  !

Item was added:
+ ----- Method: ScrollPane>>updateMinimumExtent (in category 'layout') -----
+ updateMinimumExtent
+ "This grows only. For shrinking scroll bars, this might have to be changed."
+
+ self minimumWidth: (self minimumWidth max: self minScrollbarWidth).
+ self minimumHeight: (self minimumHeight max: self minScrollbarHeight).!

Item was changed:
+ ----- Method: ScrollPane>>vExtraScrollRange (in category 'geometry ranges') -----
- ----- Method: ScrollPane>>vExtraScrollRange (in category 'geometry') -----
  vExtraScrollRange
  "Return the amount of extra blank space to include below the bottom of the scroll content."
  ^ 0
  !

Item was changed:
  ----- Method: ScrollPane>>vIsScrollbarNeeded (in category 'scrolling') -----
  vIsScrollbarNeeded
  "Return whether the verticle scrollbar is needed"
 
  "Don't do anything with the retractable scrollbar unless we have focus"
  retractableScrollBar & self hasFocus not ifTrue: [^false].
 
  "Don't show it if we were told not to."
+ self vScrollBarPolicy == #never ifTrue: [^false].
- (self valueOfProperty: #noVScrollBarPlease ifAbsent: [false]) ifTrue: [^false].
 
  "Always show it if we were told to"
+ self vScrollBarPolicy == #always ifTrue: [^true].
- (self valueOfProperty: #vScrollBarAlways ifAbsent: [false]) ifTrue: [^true].
 
  ^self vIsScrollable
  !

Item was changed:
+ ----- Method: ScrollPane>>vLeftoverScrollRange (in category 'geometry ranges') -----
- ----- Method: ScrollPane>>vLeftoverScrollRange (in category 'geometry') -----
  vLeftoverScrollRange
  "Return the entire scrolling range minus the currently viewed area."
 
  ^ scroller hasSubmorphs
  ifFalse: [0]
  ifTrue: [self vTotalScrollRange - scroller height max: 0]
  !

Item was changed:
+ ----- Method: ScrollPane>>vScrollBar (in category 'accessing') -----
- ----- Method: ScrollPane>>vScrollBar (in category 'access') -----
  vScrollBar
  ^ scrollBar!

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

Item was added:
+ ----- Method: ScrollPane>>vScrollBarPolicy: (in category 'accessing') -----
+ vScrollBarPolicy: aSymbol
+ "#always, #never, #whenNeeded"
+
+ vScrollBarPolicy := aSymbol.!

Item was changed:
+ ----- Method: ScrollPane>>vTotalScrollRange (in category 'geometry ranges') -----
- ----- Method: ScrollPane>>vTotalScrollRange (in category 'geometry') -----
  vTotalScrollRange
  "Return the entire scrolling range."
  ^ self vUnadjustedScrollRange + self vExtraScrollRange
  !

Item was changed:
+ ----- Method: ScrollPane>>vUnadjustedScrollRange (in category 'geometry ranges') -----
- ----- Method: ScrollPane>>vUnadjustedScrollRange (in category 'geometry') -----
  vUnadjustedScrollRange
  "Return the height extent of the receiver's submorphs."
  | submorphBounds |
  submorphBounds := scroller localSubmorphBounds ifNil: [^ 0].
  ^ submorphBounds bottom
  !

Item was changed:
+ ----- Method: ScrollPane>>wantsSlot (in category 'accessing') -----
- ----- Method: ScrollPane>>wantsSlot (in category 'access') -----
  wantsSlot
  "For now do it the old way, until we sort this out"
  ^ true!

Item was changed:
  (PackageInfo named: 'Morphic') postscript: '"Update existing scrollbars."
- ScrollBar allSubInstances do: [:sb |
- sb removeAllMorphs; initializeSlider].
  ScrollPane allSubInstances do: [:sc |
+ sc vScrollBarPolicy ifNil: [
+ sc vScrollBarPolicy: #whenNeeded.
+ (sc hasProperty: #vScrollBarAlways)
+ ifTrue: [sc vScrollBarPolicy: #always].
+ (sc hasProperty: #noVScrollBarPlease)
+ ifTrue: [sc vScrollBarPolicy: #never]].
+ sc hScrollBarPolicy ifNil: [
+ sc hScrollBarPolicy: #whenNeeded.
+ (sc hasProperty: #hScrollBarAlways)
+ ifTrue: [sc hScrollBarPolicy: #always].
+ (sc hasProperty: #noHScrollBarPlease)
+
+ ifTrue: [sc hScrollBarPolicy: #never]].
+ sc scrollBarThickness: ScrollPane scrollBarThickness.
+
+ sc
+ resizeScrollBars;
+ resizeScroller;
+ hideOrShowScrollBars].
- sc vScrollBar
- setValueSelector: #vScrollBarValue:;
- menuSelector: #vScrollBarMenuButtonPressed:.
- sc hScrollBar
- setValueSelector: #hScrollBarValue:;
- menuSelector: #hScrollBarMenuButtonPressed:.
- sc vSetScrollDelta; hSetScrollDelta].
 
  (Preferences dictionaryOfPreferences at: #alternativeWindowBoxesLook) defaultValue: false.
- "Force SystemProgressMorph to be reset"
- SystemProgressMorph initialize; reset.
 
  "Initialize the key bindings and menus"
  Editor initialize.
 
- "Retain scrollBar look now that the pref actually does something"
- Preferences enable: #gradientScrollBars.
-
  "apply the new icons"
  MenuIcons initializeIcons.
  TheWorldMainDockingBar updateInstances.
 
- "Cleanup old-style preferences here. Remove before new release."
- Preferences removePreference: #gradientMenu. "Now in MenuMorph."
- Preferences removePreference: #roundedMenuCorners. "Now in MenuMorph."
-
- "Fix clipping bug of open windows. New ones are not affected."
- TransformMorph allInstances do: [:ea | ea clipSubmorphs: true].
-
- "Now in ScrollBar."
- Preferences removePreference: #scrollBarsWithoutMenuButton.
-
  "Keyboard focus indication."
  PluggableTextMorph allSubInstances do: [:m |
  m textMorph setProperty: #indicateKeyboardFocus toValue: #never].'!

This update works fine if you close all your tools because of this:

http://forum.world.st/Class-recompilation-bug-td4821745.html

Sorry for the inconvenience.

Best,
Marcel

Nevertheless, Smart Splitters should be much faster now. :-)

Best,
Marcel

On Sat, Apr 25, 2015 at 08:28:11AM +0000, [hidden email] wrote:
Really?!? Wow, nice work.

Dave

I approximated that number after running several #bench on parts of the scroll pane layouting algorithm. For example:

ScrollPane >> #minWidth
ScrollPane >> #setScrollDeltas
ScrollPane >> #innerBounds
ScrollPane >> #scrollbarThickness

Or "pane hasProperty: #hScrollBarAlways" vs. "pane hScrollBarPolicy == #always".

These modifications were motivated by Chris, who noticed a significant performance decrease in Smart Splitters after some of my recent fixes/refactorings in scroll bars, scroll panes, and their subclasses. :)

Best,
Marcel

On 25-04-2015, at 8:28 AM, [hidden email] wrote:


Good work that man; keep it up and pretty soon everything will be 1000x faster

tim
--
tim Rowledge; [hidden email]; http://www.rowledge.org/tim
Useful random insult:- When a thought crosses her mind, it's a long and lonely journey.