The Trunk: Morphic-mt.776.mcz

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

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

Name: Morphic-mt.776
Author: mt
Time: 9 March 2015, 8:00:45.812 am
UUID: 7bf57a20-04fc-c646-9e8c-81d876a187f5
Ancestors: Morphic-topa.775

Scrolling/drawing modified to consider visiblilty of items in SimpleHierarchicalListMorph. The implementation of keyboard event handling is now also closer to PluggableListMorph.

=============== Diff against Morphic-topa.775 ===============

Item was added:
+ ----- Method: ScrollPane>>offsetToShow: (in category 'scrolling') -----
+ offsetToShow: aRectangle
+ "Calculate the offset necessary to show the rectangle."
+
+ | offset scrollRange |
+ offset := scroller offset.
+ scrollRange := self hUnadjustedScrollRange @ self vUnadjustedScrollRange.
+
+ "Vertical Scrolling"
+ (aRectangle top - offset y) < 0
+ ifTrue: [offset := offset x @ (
+ (aRectangle top min: scrollRange y - scroller height))].
+
+ ((aRectangle bottom - offset y) > scroller height and: [aRectangle height <= scroller height])
+ ifTrue: [offset := offset x @ (
+ (aRectangle top - scroller height + aRectangle height min: scrollRange y - scroller height))].
+
+ "Horizontal Scrolling"
+ (aRectangle left - offset x) < 0
+ ifTrue: [offset := (
+ (aRectangle left min: scrollRange x - scroller width)) @ offset y].
+
+ ((aRectangle right - offset x) > scroller width and: [aRectangle width <= scroller width])
+ ifTrue: [offset := (
+ (aRectangle left - scroller width + aRectangle width min: scrollRange x - scroller width)) @ offset y].
+
+ ^ offset!

Item was changed:
  ----- Method: ScrollPane>>scrollToShow: (in category 'scrolling') -----
  scrollToShow: aRectangle
- "scroll to include as much of aRectangle as possible, where aRectangle is in the scroller's local space"
- | range |
- ((aRectangle top - scroller offset y) >= 0 and: [
- (aRectangle bottom - scroller offset y) <= (self innerBounds height) ])
- ifTrue:[ "already visible"^self ].
 
+ scroller offset: (self offsetToShow: aRectangle).
+ self setScrollDeltas.!
- range := self vLeftoverScrollRange.
- scrollBar value: (range > 0
- ifTrue: [((aRectangle top) / self vLeftoverScrollRange)
- truncateTo: scrollBar scrollDelta]
- ifFalse: [0]).
- scroller offset: -3 @ (range * scrollBar value).!

Item was changed:
  ----- Method: SimpleHierarchicalListMorph>>adjustSubmorphPositions (in category 'private') -----
  adjustSubmorphPositions
 
  | p |
-
  p := 0@0.
  scroller submorphsDo: [ :each | | h |
+ each visible ifTrue: [
+ h := each height.
+ each privateBounds: (p extent: 9999@h).
+ p := p + (0@h) ]].
- h := each height.
- each privateBounds: (p extent: 9999@h).
- p := p + (0@h)
- ].
  self
  changed;
  layoutChanged;
  setScrollDeltas.
  !

Item was changed:
  ----- Method: SimpleHierarchicalListMorph>>arrowKey: (in category 'keyboard navigation') -----
+ arrowKey: asciiValue
- arrowKey: aChar
  "Handle a keyboard navigation character. Answer true if handled, false if not."
  | keyEvent |
+ keyEvent := asciiValue.
- keyEvent := aChar asciiValue.
       keyEvent = 31 ifTrue:["down"
  self setSelectionIndex: self getSelectionIndex+1.
  ^true].
       keyEvent = 30 ifTrue:["up"
  self setSelectionIndex: (self getSelectionIndex-1 max: 1).
  ^true].
       keyEvent = 1  ifTrue: ["home"
  self setSelectionIndex: 1.
  ^true].
       keyEvent = 4  ifTrue: ["end"
  self setSelectionIndex: scroller submorphs size.
  ^true].
        keyEvent = 11 ifTrue: ["page up"
  self setSelectionIndex: (self getSelectionIndex - self numSelectionsInView max: 1).
  ^true].
       keyEvent = 12  ifTrue: ["page down"
  self setSelectionIndex: self getSelectionIndex + self numSelectionsInView.
  ^true].
  keyEvent = 29 ifTrue:["right"
  selectedMorph ifNotNil:[
  (selectedMorph canExpand and:[selectedMorph isExpanded not])
  ifTrue:[self toggleExpandedState: selectedMorph]
  ifFalse:[self setSelectionIndex: self getSelectionIndex+1].
  ].
  ^true].
  keyEvent = 28 ifTrue:["left"
  selectedMorph ifNotNil:[
  (selectedMorph isExpanded)
  ifTrue:[self toggleExpandedState: selectedMorph]
  ifFalse:[self setSelectionIndex: (self getSelectionIndex-1 max: 1)].
  ].
  ^true].
  ^false!

Item was changed:
  ----- Method: SimpleHierarchicalListMorph>>drawLinesOn: (in category 'drawing') -----
  drawLinesOn: aCanvas
+
  | lColor |
  lColor := self lineColor.
  aCanvas
  transformBy: scroller transform
  clippingTo: scroller innerBounds
  during:[:clippedCanvas |
+ scroller submorphs
+ select: [:submorph | submorph visible]
+ thenDo: [ :submorph |
+ ((submorph isExpanded
+ or: [clippedCanvas isVisible: submorph fullBounds] )
+ or: [ submorph nextSibling notNil and: [clippedCanvas isVisible: submorph nextSibling]])
+ ifTrue: [submorph drawLinesOn: clippedCanvas lineColor: lColor] ] ]
- scroller submorphs do: [ :submorph |
- (
- (submorph isExpanded) or: [
- (clippedCanvas isVisible: submorph fullBounds) or: [
- (submorph nextSibling notNil and: [clippedCanvas isVisible: submorph nextSibling]) ]]) ifTrue:[
- submorph drawLinesOn: clippedCanvas lineColor: lColor.
- ]
- ].
- ]
  smoothing: scroller smoothing.
  !

Item was changed:
  ----- Method: SimpleHierarchicalListMorph>>itemFromPoint: (in category 'event handling') -----
  itemFromPoint: aPoint
  "Return the list element (morph) at the given point or nil if outside"
+ | ptY visibleRows |
- | ptY |
  scroller hasSubmorphs ifFalse:[^nil].
  (scroller fullBounds containsPoint: aPoint) ifFalse:[^nil].
+
+ visibleRows := scroller submorphs select: [:m | m visible].
+
+ ptY := (visibleRows first point: aPoint from: self) y.
- ptY := (scroller firstSubmorph point: aPoint from: self) y.
  "note: following assumes that submorphs are vertical, non-overlapping, and ordered"
+ visibleRows first top > ptY ifTrue:[^nil].
+ visibleRows last bottom < ptY ifTrue:[^nil].
- scroller firstSubmorph top > ptY ifTrue:[^nil].
- scroller lastSubmorph bottom < ptY ifTrue:[^nil].
  "now use binary search"
+ ^visibleRows
+ findBinary:[:item|
- ^scroller
- findSubmorphBinary:[:item|
  (item top <= ptY and:[item bottom >= ptY])
  ifTrue:[0] "found"
+ ifFalse:[ (item top + item bottom // 2) > ptY ifTrue:[-1] ifFalse:[1]]]
+ ifNone: [nil]!
- ifFalse:[ (item top + item bottom // 2) > ptY ifTrue:[-1] ifFalse:[1]]]!

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].
+
+ (self keyStrokeAction: event) ifTrue: [^ true].
+
+ ^ false!
- | args aCharacter |
- (self scrollByKeyboard: event) ifTrue: [^self].
- aCharacter := event keyCharacter.
- (self arrowKey: aCharacter) ifTrue: [^true].
- keystrokeActionSelector isNil ifTrue: [^false].
- (args := keystrokeActionSelector numArgs) = 1
- ifTrue: [^model perform: keystrokeActionSelector with: aCharacter].
- args = 2
- ifTrue:
- [^model
- perform: keystrokeActionSelector
- with: aCharacter
- with: self].
- ^self
- error: 'The keystrokeActionSelector must be a 1- or 2-keyword symbol'!

Item was added:
+ ----- Method: SimpleHierarchicalListMorph>>keyStrokeAction: (in category 'event handling') -----
+ keyStrokeAction: event
+
+ keystrokeActionSelector ifNil: [^false].
+
+ keystrokeActionSelector numArgs = 1
+ ifTrue:
+ [^model
+ perform: keystrokeActionSelector
+ with: event keyCharacter].
+ keystrokeActionSelector numArgs = 2
+ ifTrue:
+ [^model
+ perform: keystrokeActionSelector
+ with: event keyCharacter
+ with: self].
+ ^self error: 'The keystrokeActionSelector must be a 1- or 2-keyword symbol'!

Item was changed:
  ----- Method: SimpleHierarchicalListMorph>>selectionIndex: (in category 'selection') -----
  selectionIndex: idx
  "Called internally to select the index-th item."
+ | theMorph index |
- | theMorph range index |
  idx ifNil: [^ self].
  index := idx min: scroller submorphs size max: 0.
  (theMorph := index = 0 ifTrue: [nil] ifFalse: [scroller submorphs at: index])
+ ifNotNil: [self scrollToShow: theMorph bounds].
- ifNotNil:
- [((theMorph bounds top - scroller offset y) >= 0
- and: [(theMorph bounds bottom - scroller offset y) <= bounds height]) ifFalse:
- ["Scroll into view -- should be elsewhere"
- range := self vTotalScrollRange.
- scrollBar value: (range > 0
- ifTrue: [((index-1 * theMorph height) / self vTotalScrollRange)
- truncateTo: scrollBar scrollDelta]
- ifFalse: [0]).
- scroller offset: -3 @ (range * scrollBar value)]].
  self selectedMorph: theMorph!

Item was changed:
  ----- Method: SimpleHierarchicalListMorph>>setSelectionIndex: (in category 'keyboard navigation') -----
  setSelectionIndex: idx
  "Called internally to select the index-th item."
+ | theMorph index max currentIndex |
- | theMorph index |
  idx ifNil: [^ self].
+ max := scroller submorphs size.
+ currentIndex := self getSelectionIndex.
+
+ index := idx min: max max: 0.
- index := idx min: scroller submorphs size max: 0.
  theMorph := index = 0 ifTrue: [nil] ifFalse: [scroller submorphs at: index].
+
+ "Skip invisible rows."
+ [theMorph notNil and: [theMorph visible not]] whileTrue: [
+ currentIndex < index
+ ifTrue: [index := index + 1]
+ ifFalse: [index := index - 1].
+ (index < 1 or: [index > max]) ifTrue: [^ self].
+ theMorph := scroller submorphs at: index.
+ ].
  self setSelectedMorph: theMorph.!

Item was added:
+ ----- Method: SimpleHierarchicalListMorph>>specialKeyPressed: (in category 'event handling') -----
+ specialKeyPressed: asciiValue
+
+ ^ self arrowKey: asciiValue!