'From Squeak3.1alpha of 28 February 2001 [latest update: #3861] on 17 March 2001 at 6:31:13 pm'! "Change Set: LeanerLists Date: 17 March 2001 Author: Andreas Raab Make list morphs handle events itself rather than overriding the list item event handlers. This change removes zillions of event handlers in the list elements and also allows list elements to be active without having their event handler silently overwritten by the list morph."! !Morph methodsFor: 'submorphs-accessing' stamp: 'ar 3/17/2001 15:32'! findSubmorphBinary: aBlock "Use binary search for finding a specific submorph of the receiver. Caller must be certain that the ordering holds for the submorphs." ^submorphs findBinary: aBlock ifNone:[nil].! ! !Morph methodsFor: 'drawing' stamp: 'ar 3/17/2001 15:56'! highlightForMouseDown: aBoolean aBoolean ifTrue:[self setProperty: #highlightedForMouseDown toValue: aBoolean] ifFalse:[self removeProperty: #highlightedForMouseDown. self resetExtension]. self changed! ! !IndentingListItemMorph methodsFor: 'mouse events' stamp: 'ar 3/17/2001 17:32'! inToggleArea: aPoint ^self toggleRectangle containsPoint: aPoint! ! !IndentingListItemMorph methodsFor: 'as yet unclassified' stamp: 'ar 3/17/2001 17:38'! openPath: anArray anArray isEmpty ifTrue: [^container setSelectedMorph: nil]. self withSiblingsDo: [:each | (each complexContents asString = anArray first or: [anArray first isNil]) ifTrue: [ each isExpanded ifFalse: [ each toggleExpandedState. container adjustSubmorphPositions. ]. each changed. anArray size = 1 ifTrue: [ ^container setSelectedMorph: each ]. each firstChild ifNil: [^container setSelectedMorph: nil]. ^each firstChild openPath: anArray allButFirst. ]. ]. ^container setSelectedMorph: nil ! ! !PluggableListMorph methodsFor: 'initialization' stamp: 'ar 3/17/2001 15:54'! list: listOfStrings | morphList h loc index | scroller removeAllMorphs. list _ listOfStrings ifNil: [Array new]. list isEmpty ifTrue: [self setScrollDeltas. ^ self selectedMorph: nil]. "NOTE: we will want a quick StringMorph init message, possibly even combined with event install and positioning" font ifNil: [font _ Preferences standardListFont]. morphList _ list collect: [:item | item isText ifTrue: [StringMorph contents: item font: font emphasis: (item emphasisAt: 1)] ifFalse: [StringMorph contents: item font: font]]. self highlightSelector ifNotNil:[ model perform: self highlightSelector with: list with: morphList. ]. "Lay items out vertically and install them in the scroller" h _ morphList first height "self listItemHeight". loc _ 0@0. morphList do: [:m | m bounds: (loc extent: 9999@h). loc _ loc + (0@h)]. scroller addAllMorphs: morphList. index _ self getCurrentSelectionIndex. self selectedMorph: ((index = 0 or: [index > morphList size]) ifTrue: [nil] ifFalse: [morphList at: index]). self setScrollDeltas. scrollBar setValue: 0.0! ! !PluggableListMorph methodsFor: 'accessing' stamp: 'ar 3/17/2001 15:32'! itemFromPoint: aPoint "Return the list element (morph) at the given point or nil if outside" | ptY | scroller hasSubmorphs ifFalse:[^nil]. (scroller fullBounds containsPoint: aPoint) ifFalse:[^nil]. ptY _ (scroller firstSubmorph point: aPoint from: self) y. "note: following assumes that submorphs are vertical, non-overlapping, and ordered" scroller firstSubmorph top > ptY ifTrue:[^nil]. scroller lastSubmorph bottom < ptY ifTrue:[^nil]. "now use binary search" ^scroller findSubmorphBinary:[:item| (item top <= ptY and:[item bottom >= ptY]) ifTrue:[0] "found" ifFalse:[ (item top + item bottom // 2) > ptY ifTrue:[-1] ifFalse:[1]]]! ! !PluggableListMorph methodsFor: 'events' stamp: 'ar 3/17/2001 15:34'! doubleClick: event | aMorph | doubleClickSelector isNil ifTrue: [^super doubleClick: event]. aMorph _ self itemFromPoint: event position. aMorph ifNil:[^super doubleClick: event]. selectedMorph ifNil: [self setSelectedMorph: aMorph]. ^ self model perform: doubleClickSelector! ! !PluggableListMorph methodsFor: 'events' stamp: 'ar 3/17/2001 16:16'! handleMouseMove: anEvent "Reimplemented because we really want #mouseMove when a morph is dragged around" anEvent wasHandled ifTrue:[^self]. "not interested" (anEvent anyButtonPressed and:[anEvent hand mouseFocus == self]) ifFalse:[^self]. anEvent wasHandled: true. self mouseMove: anEvent. (self handlesMouseStillDown: anEvent) ifTrue:[ "Step at the new location" self startStepping: #handleMouseStillDown: at: Time millisecondClockValue arguments: {anEvent copy resetHandlerFields} stepTime: 1]. ! ! !PluggableListMorph methodsFor: 'events' stamp: 'ar 3/17/2001 16:53'! handlesBasicKeys " if ya don't want the list to automatically handle non-modifier key (excluding shift key) input, return false" ^ true! ! !PluggableListMorph methodsFor: 'events' stamp: 'ar 3/17/2001 16:05'! handlesMouseOverDragging: evt ^self dropEnabled! ! !PluggableListMorph methodsFor: 'events' stamp: 'ar 3/17/2001 16:01'! mouseDown: evt | aMorph selectors | evt yellowButtonPressed "First check for option (menu) click" ifTrue: [^ self yellowButtonActivity: evt shiftPressed]. aMorph _ self itemFromPoint: evt position. aMorph ifNil:[^super mouseDown: evt]. self dragEnabled ifTrue: [aMorph highlightForMouseDown]. selectors _ Array with: #click: with: (doubleClickSelector ifNotNil:[#doubleClick:]) with: (self dragEnabled ifTrue:[#startDrag:] ifFalse:[nil]). evt hand waitForClicksOrDrag: self event: evt selectors: selectors threshold: 10 "pixels".! ! !PluggableListMorph methodsFor: 'events' stamp: 'ar 3/17/2001 17:00'! mouseEnterDragging: evt | aMorph | (evt hand hasSubmorphs and:[self dropEnabled]) ifFalse: ["no d&d" ^super mouseEnterDragging: evt]. (self wantsDroppedMorph: evt hand firstSubmorph event: evt ) ifTrue:[ aMorph _ self itemFromPoint: evt position. aMorph ifNotNil:[self potentialDropMorph: aMorph]. evt hand newMouseFocus: self. "above is ugly but necessary for now" ].! ! !PluggableListMorph methodsFor: 'events' stamp: 'ar 3/17/2001 16:15'! mouseLeaveDragging: anEvent (self dropEnabled and:[anEvent hand hasSubmorphs]) ifFalse: ["no d&d" ^ super mouseLeaveDragging: anEvent]. self resetPotentialDropMorph. anEvent hand releaseMouseFocus: self. "above is ugly but necessary for now" ! ! !PluggableListMorph methodsFor: 'events' stamp: 'ar 3/17/2001 17:00'! mouseMove: evt (self dropEnabled and:[evt hand hasSubmorphs]) ifFalse:[^super mouseMove: evt]. potentialDropMorph ifNotNil:[ (potentialDropMorph containsPoint: (potentialDropMorph point: evt position from: self)) ifTrue:[^self]. ]. self mouseLeaveDragging: evt. (self containsPoint: evt position) ifTrue:[self mouseEnterDragging: evt].! ! !PluggableListMorph methodsFor: 'events' stamp: 'ar 3/17/2001 15:41'! mouseUp: event | aMorph | aMorph _ self itemFromPoint: event position. aMorph ifNotNil: [aMorph highlightForMouseDown: false]. model okToChange ifFalse: [ ^ self]. "No change if model is locked" ((autoDeselect == nil or: [autoDeselect]) and: [aMorph == selectedMorph]) ifTrue: [self setSelectedMorph: nil] ifFalse: [self setSelectedMorph: aMorph]. Cursor normal show. ! ! !PluggableListMorph methodsFor: 'drag and drop' stamp: 'ar 3/17/2001 16:19'! acceptDroppingMorph: aMorph event: evt "This message is sent when a morph is dropped onto a morph that has agreed to accept the dropped morph by responding 'true' to the wantsDroppedMorph:Event: message. The default implementation just adds the given morph to the receiver." "Here we let the model do its work." self model acceptDroppingMorph: aMorph event: evt inMorph: self. self resetPotentialDropMorph. evt hand releaseMouseFocus: self. Cursor normal show. ! ! !PluggableListMorph methodsFor: 'drag and drop' stamp: 'ar 3/17/2001 17:37'! startDrag: evt | ddm itemMorph | self dragEnabled ifTrue:[ itemMorph _ scroller submorphs detect:[:any| any highlightedForMouseDown] ifNone:[nil]]. (itemMorph isNil or:[evt hand hasSubmorphs]) ifTrue: [^self]. itemMorph highlightForMouseDown: false. model okToChange ifFalse: [ Cursor normal show. ^ self]. "No change if model is locked" "itemMorph ~= self selection ifTrue: [self setSelectedMorph: itemMorph]." ddm _ TransferMorph withPassenger: (self model dragPassengerFor: itemMorph inMorph: self) from: self. ddm dragTransferType: (self model dragTransferTypeForMorph: self). Preferences dragNDropWithAnimation ifTrue: [self model dragAnimationFor: itemMorph transferMorph: ddm]. evt hand grabMorph: ddm. evt hand releaseMouseFocus: self.! ! !PluggableListMorph methodsFor: 'obsolete' stamp: 'ar 3/17/2001 17:19'! doubleClick: event onItem: aMorph self removeObsoleteEventHandlers.! ! !PluggableListMorph methodsFor: 'obsolete' stamp: 'ar 3/17/2001 17:19'! mouseDown: event onItem: aMorph self removeObsoleteEventHandlers.! ! !PluggableListMorph methodsFor: 'obsolete' stamp: 'ar 3/17/2001 17:20'! mouseEnterDragging: anEvent onItem: aMorph self removeObsoleteEventHandlers.! ! !PluggableListMorph methodsFor: 'obsolete' stamp: 'ar 3/17/2001 17:20'! mouseLeaveDragging: anEvent onItem: aMorph self removeObsoleteEventHandlers.! ! !PluggableListMorph methodsFor: 'obsolete' stamp: 'ar 3/17/2001 17:20'! mouseUp: event onItem: aMorph self removeObsoleteEventHandlers.! ! !PluggableListMorph methodsFor: 'obsolete' stamp: 'ar 3/17/2001 17:20'! removeObsoleteEventHandlers scroller submorphs do:[:m| m eventHandler: nil; highlightForMouseDown: false; resetExtension].! ! !PluggableListMorph methodsFor: 'obsolete' stamp: 'ar 3/17/2001 17:20'! startDrag: evt onItem: itemMorph self removeObsoleteEventHandlers.! ! !PluggableListMorphOfMany methodsFor: 'initialization' stamp: 'ar 3/17/2001 17:07'! list: listOfStrings scroller removeAllMorphs. list _ listOfStrings ifNil: [Array new]. list isEmpty ifTrue: [^ self selectedMorph: nil]. super list: listOfStrings. "At this point first morph is sensitized, and all morphs share same handler." scroller firstSubmorph on: #mouseEnterDragging send: #mouseEnterDragging:onItem: to: self. scroller firstSubmorph on: #mouseUp send: #mouseUp:onItem: to: self. "This should add this behavior to the shared event handler thus affecting all items"! ! !PluggableListMorphOfMany methodsFor: 'drawing' stamp: 'ar 3/17/2001 17:06'! drawOn: aCanvas | onMorph | super drawOn: aCanvas. 1 to: list size do: "NOTE: should be optimized to only visible morphs" [:index | (model listSelectionAt: index) ifTrue: [onMorph _ scroller submorphs at: index. aCanvas fillRectangle: (((scroller transformFrom: self) localBoundsToGlobal: onMorph bounds) intersect: scroller bounds) color: color darker]]! ! !PluggableListMorphOfMany methodsFor: 'event handling' stamp: 'ar 3/17/2001 16:21'! mouseDown: event | index oldIndex oldVal aMorph | event yellowButtonPressed ifTrue: [^ self yellowButtonActivity: event shiftPressed]. aMorph _ self itemFromPoint: event position. aMorph ifNil:[^super mouseDown: event]. model okToChange ifFalse: [^ self]. "No change if model is locked" index _ scroller submorphs indexOf: aMorph. index = 0 ifTrue: [^ self "minimize chance of selecting with a pane border drag"]. "Set meaning for subsequent dragging of selection" dragOnOrOff _ (model listSelectionAt: index) not. oldIndex _ self getCurrentSelectionIndex. oldIndex ~= 0 ifTrue: [oldVal _ model listSelectionAt: oldIndex]. "Set or clear new primary selection (listIndex)" dragOnOrOff ifTrue: [self setSelectedMorph: aMorph] ifFalse: [self setSelectedMorph: nil]. "Need to restore the old one, due to how model works, and set new one." oldIndex ~= 0 ifTrue: [model listSelectionAt: oldIndex put: oldVal]. model listSelectionAt: index put: dragOnOrOff. event hand releaseMouseFocus: aMorph. aMorph changed! ! !PluggableListMorphOfMany methodsFor: 'event handling' stamp: 'ar 3/17/2001 16:47'! mouseMove: event | index oldIndex oldVal aMorph | event position y < self top ifTrue:[ scrollBar scrollUp: 1. aMorph _ self itemFromPoint: scroller topLeft + (1@1). ] ifFalse:[ event position y > self bottom ifTrue:[ scrollBar scrollDown: 1. aMorph _ self itemFromPoint: scroller bottomLeft + (1@-1). ] ifFalse:[ aMorph _ self itemFromPoint: event position. ]. ]. aMorph printString displayAt: 0@100. aMorph ifNil:[^super mouseDown: event]. model okToChange ifFalse: [^ self]. "No change if model is locked" index _ scroller submorphs indexOf: aMorph. index = 0 ifTrue: [^ self "minimize chance of selecting with a pane border drag"]. "Set meaning for subsequent dragging of selection" oldIndex _ self getCurrentSelectionIndex. oldIndex ~= 0 ifTrue: [oldVal _ model listSelectionAt: oldIndex]. "Set or clear new primary selection (listIndex)" dragOnOrOff ifTrue: [self setSelectedMorph: aMorph] ifFalse: [self setSelectedMorph: nil]. "Need to restore the old one, due to how model works, and set new one." oldIndex ~= 0 ifTrue: [model listSelectionAt: oldIndex put: oldVal]. model listSelectionAt: index put: dragOnOrOff. aMorph changed.! ! !PluggableListMorphOfMany methodsFor: 'event handling' stamp: 'ar 3/17/2001 16:23'! mouseUp: event dragOnOrOff _ nil. "So improperly started drags will have not effect"! ! !PluggableListMorphOfMany methodsFor: 'obsolete' stamp: 'ar 3/17/2001 18:16'! mouseDown: event onItem: aMorph self removeObsoleteEventHandlers.! ! !PluggableListMorphOfMany methodsFor: 'obsolete' stamp: 'ar 3/17/2001 18:16'! mouseEnterDragging: event onItem: aMorph self removeObsoleteEventHandlers.! ! !PluggableListMorphOfMany methodsFor: 'obsolete' stamp: 'ar 3/17/2001 18:16'! mouseUp: event onItem: aMorph self removeObsoleteEventHandlers.! ! !PluggableMultiColumnListMorph methodsFor: 'initialization' stamp: 'ar 3/17/2001 15:54'! list: arrayOfLists | listOfStrings arrayOfMorphs index | lists _ arrayOfLists. scroller removeAllMorphs. listOfStrings _ arrayOfLists == nil ifTrue: [Array new] ifFalse: [ arrayOfLists isEmpty ifFalse: [ arrayOfLists at: 1]]. list _ listOfStrings ifNil: [Array new]. list isEmpty ifTrue: [self setScrollDeltas. ^ self selectedMorph: nil]. arrayOfMorphs _ self createMorphicListsFrom: arrayOfLists. self layoutMorphicLists: arrayOfMorphs. arrayOfMorphs do: [:morphList | scroller addAllMorphs: morphList]. index _ self getCurrentSelectionIndex. self selectedMorph: ((index = 0 or: [index > (arrayOfMorphs at: 1) size]) ifFalse: [(arrayOfMorphs at: 1) at: index]). self setScrollDeltas. scrollBar setValue: 0.0! ! !SimpleHierarchicalListMorph methodsFor: 'initialization' stamp: 'ar 3/17/2001 17:39'! list: aCollection | wereExpanded morphList | wereExpanded _ self currentlyExpanded. scroller removeAllMorphs. (aCollection isNil or: [aCollection isEmpty]) ifTrue: [^ self selectedMorph: nil]. morphList _ OrderedCollection new. self addMorphsTo: morphList from: aCollection allowSorting: false withExpandedItems: wereExpanded atLevel: 0. self insertNewMorphs: morphList.! ! !SimpleHierarchicalListMorph methodsFor: 'events' stamp: 'ar 3/17/2001 17:39'! expand: aMorph to: level | allChildren | aMorph toggleExpandedState. allChildren _ OrderedCollection new: 10. aMorph recursiveAddTo: allChildren. allChildren do: [:each | ((each canExpand and: [each isExpanded not]) and: [level > 0]) ifTrue: [self expand: each to: level-1]].! ! !SimpleHierarchicalListMorph methodsFor: 'events' stamp: 'ar 3/17/2001 17:39'! expandAll: aMorph except: aBlock | allChildren | (aBlock value: aMorph complexContents) ifFalse: [^self]. aMorph toggleExpandedState. allChildren _ OrderedCollection new: 10. aMorph recursiveAddTo: allChildren. allChildren do: [:each | (each canExpand and: [each isExpanded not]) ifTrue: [self expandAll: each except: aBlock]].! ! !SimpleHierarchicalListMorph methodsFor: 'events' stamp: 'ar 3/17/2001 17:26'! handleMouseMove: anEvent "Reimplemented because we really want #mouseMove when a morph is dragged around" anEvent wasHandled ifTrue:[^self]. "not interested" (anEvent anyButtonPressed and:[anEvent hand mouseFocus == self]) ifFalse:[^self]. anEvent wasHandled: true. self mouseMove: anEvent. (self handlesMouseStillDown: anEvent) ifTrue:[ "Step at the new location" self startStepping: #handleMouseStillDown: at: Time millisecondClockValue arguments: {anEvent copy resetHandlerFields} stepTime: 1]. ! ! !SimpleHierarchicalListMorph methodsFor: 'events' stamp: 'ar 3/17/2001 17:27'! handlesMouseOverDragging: evt ^self dropEnabled! ! !SimpleHierarchicalListMorph methodsFor: 'events' stamp: 'ar 3/17/2001 17:44'! mouseDown: evt | aMorph selectors | aMorph _ self itemFromPoint: evt position. (aMorph notNil and:[aMorph inToggleArea: (aMorph point: evt position from: self)]) ifTrue:[^self toggleExpandedState: aMorph event: evt]. evt yellowButtonPressed "First check for option (menu) click" ifTrue: [^ self yellowButtonActivity: evt shiftPressed]. aMorph ifNil:[^super mouseDown: evt]. aMorph highlightForMouseDown. selectors _ Array with: #click: with: nil with: (self dragEnabled ifTrue:[#startDrag:] ifFalse:[nil]). evt hand waitForClicksOrDrag: self event: evt selectors: selectors threshold: 10 "pixels".! ! !SimpleHierarchicalListMorph methodsFor: 'events' stamp: 'ar 3/17/2001 17:26'! mouseEnterDragging: evt | aMorph | (evt hand hasSubmorphs and:[self dropEnabled]) ifFalse: ["no d&d" ^super mouseEnterDragging: evt]. (self wantsDroppedMorph: evt hand firstSubmorph event: evt ) ifTrue:[ aMorph _ self itemFromPoint: evt position. aMorph ifNotNil:[self potentialDropMorph: aMorph]. evt hand newMouseFocus: self. "above is ugly but necessary for now" ].! ! !SimpleHierarchicalListMorph methodsFor: 'events' stamp: 'ar 3/17/2001 17:27'! mouseLeave: event super mouseLeave: event. event hand releaseKeyboardFocus: self.! ! !SimpleHierarchicalListMorph methodsFor: 'events' stamp: 'ar 3/17/2001 17:27'! mouseLeaveDragging: anEvent (self dropEnabled and:[anEvent hand hasSubmorphs]) ifFalse: ["no d&d" ^ super mouseLeaveDragging: anEvent]. self resetPotentialDropMorph. anEvent hand releaseMouseFocus: self. "above is ugly but necessary for now" ! ! !SimpleHierarchicalListMorph methodsFor: 'events' stamp: 'ar 3/17/2001 17:27'! mouseMove: evt (self dropEnabled and:[evt hand hasSubmorphs]) ifFalse:[^super mouseMove: evt]. potentialDropMorph ifNotNil:[ (potentialDropMorph containsPoint: (potentialDropMorph point: evt position from: self)) ifTrue:[^self]. ]. self mouseLeaveDragging: evt. (self containsPoint: evt position) ifTrue:[self mouseEnterDragging: evt].! ! !SimpleHierarchicalListMorph methodsFor: 'events' stamp: 'ar 3/17/2001 17:44'! mouseUp: event | aMorph | aMorph _ self itemFromPoint: event position. aMorph ifNil:[^self]. aMorph highlightedForMouseDown ifFalse:[^self]. aMorph highlightForMouseDown: false. model okToChange ifFalse: [ ^ self]. "No change if model is locked" ((autoDeselect == nil or: [autoDeselect]) and: [aMorph == selectedMorph]) ifTrue: [self setSelectedMorph: nil] ifFalse: [self setSelectedMorph: aMorph]. Cursor normal show. ! ! !SimpleHierarchicalListMorph methodsFor: 'events' stamp: 'ar 3/17/2001 17:39'! toggleExpandedState: aMorph event: event | oldState | "self setSelectedMorph: aMorph." event yellowButtonPressed ifTrue: [ oldState _ aMorph isExpanded. scroller submorphs copy do: [ :each | (each canExpand and: [each isExpanded = oldState]) ifTrue: [ each toggleExpandedState. ]. ]. ] ifFalse: [ aMorph toggleExpandedState. ]. self adjustSubmorphPositions. ! ! !SimpleHierarchicalListMorph methodsFor: 'dropping/grabbing' stamp: 'ar 3/17/2001 17:37'! startDrag: evt | ddm itemMorph | self dragEnabled ifTrue:[ itemMorph _ scroller submorphs detect:[:any| any highlightedForMouseDown] ifNone:[nil]]. (itemMorph isNil or:[evt hand hasSubmorphs]) ifTrue: [^self]. itemMorph highlightForMouseDown: false. itemMorph ~= self selectedMorph ifTrue: [self setSelectedMorph: itemMorph]. ddm _ TransferMorph withPassenger: (self model dragPassengerFor: itemMorph inMorph: self) from: self. ddm dragTransferType: (self model dragTransferTypeForMorph: self). Preferences dragNDropWithAnimation ifTrue: [self model dragAnimationFor: itemMorph transferMorph: ddm]. evt hand grabMorph: ddm. evt hand releaseMouseFocus: self.! ! !SimpleHierarchicalListMorph methodsFor: 'accessing' stamp: 'ar 3/17/2001 17:25'! itemFromPoint: aPoint "Return the list element (morph) at the given point or nil if outside" | ptY | scroller hasSubmorphs ifFalse:[^nil]. (scroller fullBounds containsPoint: aPoint) ifFalse:[^nil]. ptY _ (scroller firstSubmorph point: aPoint from: self) y. "note: following assumes that submorphs are vertical, non-overlapping, and ordered" scroller firstSubmorph top > ptY ifTrue:[^nil]. scroller lastSubmorph bottom < ptY ifTrue:[^nil]. "now use binary search" ^scroller findSubmorphBinary:[:item| (item top <= ptY and:[item bottom >= ptY]) ifTrue:[0] "found" ifFalse:[ (item top + item bottom // 2) > ptY ifTrue:[-1] ifFalse:[1]]]! ! !SimpleHierarchicalListMorph methodsFor: 'obsolete' stamp: 'ar 3/17/2001 17:40'! mouseDown: event onItem: aMorph self removeObsoleteEventHandlers. ! ! !SimpleHierarchicalListMorph methodsFor: 'obsolete' stamp: 'ar 3/17/2001 17:40'! mouseEnterDragging: anEvent onItem: aMorph self removeObsoleteEventHandlers.! ! !SimpleHierarchicalListMorph methodsFor: 'obsolete' stamp: 'ar 3/17/2001 17:39'! mouseLeaveDragging: anEvent onItem: aMorph self removeObsoleteEventHandlers.! ! !SimpleHierarchicalListMorph methodsFor: 'obsolete' stamp: 'ar 3/17/2001 17:38'! removeObsoleteEventHandlers scroller submorphs do:[:m| m eventHandler: nil; highlightForMouseDown: false; resetExtension].! ! !SimpleHierarchicalListMorph methodsFor: 'obsolete' stamp: 'ar 3/17/2001 17:39'! startDrag: evt onItem: itemMorph self removeObsoleteEventHandlers.! ! SimpleHierarchicalListMorph removeSelector: #enableDragNDrop:! SimpleHierarchicalListMorph removeSelector: #enableDrop:! SimpleHierarchicalListMorph removeSelector: #installEventHandlerOn:! !PluggableListMorphOfMany reorganize! ('initialization' list:) ('drawing' drawOn:) ('event handling' mouseDown: mouseMove: mouseUp: update:) ('obsolete' mouseDown:onItem: mouseEnterDragging:onItem: mouseUp:onItem:) ! PluggableListMorph removeSelector: #enableDragNDrop:! PluggableListMorph removeSelector: #installEventHandlerOn:! IndentingListItemMorph removeSelector: #handlesMouseDown:! "Postscript: Remove obsolete event handlers and print out how much we've reduced the number of morph extensions." | before after percent | before _ MorphExtension instanceCount. PluggableListMorph allSubInstancesDo:[:lm| lm removeObsoleteEventHandlers]. SimpleHierarchicalListMorph allSubInstancesDo:[:lm| lm removeObsoleteEventHandlers]. Smalltalk garbageCollect. after _ MorphExtension instanceCount. percent _ 100 - (after * 100.0 / before) truncateTo: 0.1. Utilities informUser: (before - after) printString, ' (', percent printString,'%) MorphExtensions have been removed' during: [(Delay forSeconds: 5) wait]. !