'From Squeak3.7alpha of ''11 September 2003'' [latest update: #5657] on 5 February 2004 at 6:05:09 pm'! "Change Set: LargeLists Date: 5 February 2003 Author: Lex Spoon Adds an option to PluggableListMorph and friends so that very large lists can be efficiently displayed. The trick is to only process list elements that are currently visible. To use the functionality, a pluggable list morph must be supplied with two additional selectors: one to extract a single element of the list, and another to query the size of the whole list without calculating the list itself. Be warned that the model must call update: whenever the list changes, and in particular whenever the list shrinks. verifyContents does not work properly for PLM's that have the two extra selectors specified."! Morph subclass: #LazyListMorph instanceVariableNames: 'listItems font selectedRow selectedRows listSource' classVariableNames: '' poolDictionaries: '' category: 'Morphic-Windows'! !LazyListMorph commentStamp: 'ls 10/11/2003 13:10' prior: 0! The morph that displays the list in a PluggableListMorph. It is "lazy" because it will only request the list items that it actually needs to display.! LazyListMorph subclass: #MulticolumnLazyListMorph instanceVariableNames: 'columnWidths' classVariableNames: '' poolDictionaries: '' category: 'Morphic-Windows'! !MulticolumnLazyListMorph commentStamp: '' prior: 0! A variant of LazyListMorph that can display multi-column lists.! ScrollPane subclass: #PluggableListMorph instanceVariableNames: 'list selectedMorph selection getListSelector getIndexSelector setIndexSelector keystrokeActionSelector autoDeselect font lastKeystrokeTime lastKeystrokes lastClickTime doubleClickSelector potentialDropMorph potentialDropRow getListSizeSelector handlesBasicKeys getListElementSelector listMorph ' classVariableNames: '' poolDictionaries: '' category: 'Morphic-Windows'! !PluggableListMorphOfMany commentStamp: '' prior: 0! A variant of its superclass that allows multiple items to be selected simultaneously. There is still a distinguished element which is selected, but each other element in the list may be flagged on or off. The model of a PluggableListMorphOfMany must implement listSelectionAt: and listSelectionAt:put: for accessing the list of elements that are selected.! PluggableListMorph subclass: #PluggableMultiColumnListMorph instanceVariableNames: 'lists selectedIndex ' classVariableNames: '' poolDictionaries: '' category: 'Morphic-Windows'! !Browser methodsFor: 'drag and drop' stamp: 'ls 6/22/2001 23:21'! dstCategoryDstListMorph: dstListMorph ^(dstListMorph getListSelector == #systemCategoryList) ifTrue: [dstListMorph potentialDropItem ] ifFalse: [self selectedSystemCategoryName]! ! !Browser methodsFor: 'drag and drop' stamp: 'ls 6/22/2001 23:20'! dstClassDstListMorph: dstListMorph | dropItem | ^(dstListMorph getListSelector == #classList) ifTrue: [(dropItem _ dstListMorph potentialDropItem) ifNotNil: [Smalltalk at: dropItem withBlanksCondensed asSymbol]] ifFalse: [dstListMorph model selectedClass]! ! !Browser methodsFor: 'drag and drop' stamp: 'ls 6/22/2001 23:19'! dstMessageCategoryDstListMorph: dstListMorph | dropItem | ^dstListMorph getListSelector == #messageCategoryList ifTrue: [dropItem _ dstListMorph potentialDropItem. dropItem ifNotNil: [dropItem asSymbol]] ifFalse: [self selectedMessageCategoryName]! ! !LazyListMorph methodsFor: 'initialization' stamp: 'nk 10/14/2003 15:24'! initialize super initialize. self color: Color black. font := Preferences standardListFont. listItems := #(). selectedRow := nil. selectedRows := PluggableSet integerSet. self adjustHeight.! ! !LazyListMorph methodsFor: 'initialization' stamp: 'ls 5/15/2001 22:12'! listSource: aListSource "set the source of list items -- typically a PluggableListMorph" listSource := aListSource. self listChanged! ! !LazyListMorph methodsFor: 'list management' stamp: 'ls 7/5/2000 18:21'! drawBoundsForRow: row "calculate the bounds that row should be drawn at. This might be outside our bounds!!" | topLeft drawBounds | topLeft := self topLeft x @ (self topLeft y + ((row - 1) * (font height))). drawBounds := topLeft extent: self width @ font height. ^drawBounds! ! !LazyListMorph methodsFor: 'list management' stamp: 'ls 6/22/2001 22:47'! listChanged "set newList to be the list of strings to display" listItems := Array new: self getListSize withAll: nil. selectedRow := nil. selectedRows := PluggableSet integerSet. self adjustHeight. self changed.! ! !LazyListMorph methodsFor: 'list management' stamp: 'ls 10/20/2001 00:09'! rowAtLocation: aPoint "return the number of the row at aPoint" | y | y := aPoint y. y < self top ifTrue: [ ^ 1 ]. ^((y - self top // (font height)) + 1) min: listItems size max: 0! ! !LazyListMorph methodsFor: 'list management' stamp: 'ls 7/13/2000 17:34'! selectRow: index "select the index-th row" selectedRows add: index. self changed.! ! !LazyListMorph methodsFor: 'list management' stamp: 'ls 7/7/2000 10:38'! selectedRow "return the currently selected row, or nil if none is selected" ^selectedRow! ! !LazyListMorph methodsFor: 'list management' stamp: 'ls 7/5/2000 17:56'! selectedRow: index "select the index-th row. if nil, remove the current selection" selectedRow := index. self changed.! ! !LazyListMorph methodsFor: 'list management' stamp: 'ls 7/13/2000 17:35'! unselectRow: index "unselect the index-th row" selectedRows remove: index ifAbsent: []. self changed.! ! !LazyListMorph methodsFor: 'drawing' stamp: 'ls 5/15/2001 22:13'! adjustHeight "private. Adjust our height to match the length of the underlying list" self height: (listItems size max: 1) * font height ! ! !LazyListMorph methodsFor: 'drawing' stamp: 'ls 5/17/2001 21:57'! bottomVisibleRowForCanvas: aCanvas "return the bottom visible row in aCanvas's clip rectangle" ^self rowAtLocation: aCanvas clipRect bottomLeft. ! ! !LazyListMorph methodsFor: 'drawing' stamp: 'ls 10/11/2003 13:12'! colorForRow: row ^(selectedRow notNil and: [ row = selectedRow]) ifTrue: [ Color red ] ifFalse: [ self color ].! ! !LazyListMorph methodsFor: 'drawing' stamp: 'ls 10/11/2003 13:12'! display: item atRow: row on: canvas "display the given item at row row" | drawBounds | drawBounds := self drawBoundsForRow: row. drawBounds := drawBounds intersect: self bounds. canvas text: item bounds: drawBounds font: font color: (self colorForRow: row).! ! !LazyListMorph methodsFor: 'drawing' stamp: 'ls 6/10/2001 12:31'! drawBackgroundForMulti: row on: aCanvas | selectionDrawBounds | "shade the background darker, if this row is selected" selectionDrawBounds := self drawBoundsForRow: row. selectionDrawBounds := selectionDrawBounds intersect: self bounds. aCanvas fillRectangle: selectionDrawBounds color: self color muchLighter! ! !LazyListMorph methodsFor: 'drawing' stamp: 'ls 6/22/2001 23:59'! drawBackgroundForPotentialDrop: row on: aCanvas | selectionDrawBounds | "shade the background darker, if this row is a potential drop target" selectionDrawBounds := self drawBoundsForRow: row. selectionDrawBounds := selectionDrawBounds intersect: self bounds. aCanvas fillRectangle: selectionDrawBounds color: self color muchLighter darker! ! !LazyListMorph methodsFor: 'drawing' stamp: 'ls 12/6/2001 21:43'! drawOn: aCanvas | | listItems size = 0 ifTrue: [ ^self ]. self drawSelectionOn: aCanvas. (self topVisibleRowForCanvas: aCanvas) to: (self bottomVisibleRowForCanvas: aCanvas) do: [ :row | (listSource itemSelectedAmongMultiple: row) ifTrue: [ self drawBackgroundForMulti: row on: aCanvas. ]. self display: (self item: row) atRow: row on: aCanvas. ]. listSource potentialDropRow > 0 ifTrue: [ self highlightPotentialDropRow: listSource potentialDropRow on: aCanvas ].! ! !LazyListMorph methodsFor: 'drawing' stamp: 'nk 10/14/2003 15:18'! drawSelectionOn: aCanvas | selectionDrawBounds | selectedRow ifNil: [ ^self ]. selectedRow = 0 ifTrue: [ ^self ]. selectionDrawBounds := self drawBoundsForRow: selectedRow. selectionDrawBounds := selectionDrawBounds intersect: self bounds. aCanvas fillRectangle: selectionDrawBounds color: (Color lightGray alpha: 0.3)! ! !LazyListMorph methodsFor: 'drawing' stamp: 'ls 7/5/2000 18:37'! font "return the font used for drawing. The response is never nil" ^font! ! !LazyListMorph methodsFor: 'drawing' stamp: 'ls 7/5/2000 18:04'! font: newFont font := (newFont ifNil: [ TextStyle default defaultFont ]). self adjustHeight. self changed.! ! !LazyListMorph methodsFor: 'drawing' stamp: 'ls 6/23/2001 00:13'! highlightPotentialDropRow: row on: aCanvas | drawBounds | drawBounds := self drawBoundsForRow: row. drawBounds := drawBounds intersect: self bounds. aCanvas frameRectangle: drawBounds color: Color blue! ! !LazyListMorph methodsFor: 'drawing' stamp: 'ls 5/17/2001 21:57'! topVisibleRowForCanvas: aCanvas "return the top visible row in aCanvas's clip rectangle" ^self rowAtLocation: aCanvas clipRect topLeft. ! ! !LazyListMorph methodsFor: 'list access' stamp: 'ls 8/19/2001 14:07'! getListItem: index "grab a list item directly from the model" ^listSource getListItem: index! ! !LazyListMorph methodsFor: 'list access' stamp: 'ls 5/15/2001 22:11'! getListSize "return the number of items in the list" listSource ifNil: [ ^0 ]. ^listSource getListSize! ! !LazyListMorph methodsFor: 'list access' stamp: 'ls 10/21/2001 20:57'! item: index "return the index-th item, using the 'listItems' cache" (index between: 1 and: listItems size) ifFalse: [ "there should have been an update, but there wasn't!!" ^self getListItem: index]. (listItems at: index) ifNil: [ listItems at: index put: (self getListItem: index). ]. ^listItems at: index! ! !MulticolumnLazyListMorph methodsFor: 'as yet unclassified' stamp: 'ls 5/17/2001 21:23'! getListItem: index ^listSource getListRow: index! ! !MulticolumnLazyListMorph methodsFor: 'as yet unclassified' stamp: 'ls 5/18/2001 16:43'! listChanged columnWidths := nil. super listChanged! ! !MulticolumnLazyListMorph methodsFor: 'drawing' stamp: 'ls 10/11/2003 13:13'! display: items atRow: row on: canvas "display the specified item, which is on the specified row; for Multicolumn lists, item w ill be a list of strings" | drawBounds | drawBounds := self drawBoundsForRow: row. drawBounds := drawBounds intersect: self bounds. items with: (1 to: items size) do: [ :item :index | "move the bounds to the right at each step" index > 1 ifTrue: [ drawBounds := drawBounds left: (drawBounds left + 6 + (columnWidths at: index - 1)). ]. canvas text: item bounds: drawBounds font: font color: (self colorForRow: row) ]! ! !MulticolumnLazyListMorph methodsFor: 'drawing' stamp: 'ls 5/17/2001 21:58'! drawOn: aCanvas self getListSize = 0 ifTrue:[ ^self ]. self setColumnWidthsFor: aCanvas. super drawOn: aCanvas! ! !MulticolumnLazyListMorph methodsFor: 'drawing' stamp: 'ls 2/9/2002 01:00'! setColumnWidthsFor: aCanvas | row topRow bottomRow | "set columnWidths for drawing on the specified canvas" columnWidths ifNil: [ columnWidths := (self item: 1) collect: [ :ignored | 0 ]. ]. topRow := (self topVisibleRowForCanvas: aCanvas) max: 1. bottomRow := (self bottomVisibleRowForCanvas: aCanvas) max: 1. topRow > bottomRow ifTrue: [ ^ self ]. topRow to: bottomRow do: [ :rowIndex | row := self item: rowIndex. columnWidths := columnWidths with: row collect: [ :currentWidth :item | | widthOfItem | widthOfItem := (font widthOfString: item). widthOfItem > currentWidth ifTrue: [ self changed. widthOfItem ] ifFalse: [ currentWidth ] ] ]! ! !PackagePaneBrowser methodsFor: 'dragNDrop util' stamp: 'ls 6/22/2001 23:21'! dstCategoryDstListMorph: dstListMorph internal: internal | dropItem | ^ internal & (dstListMorph getListSelector == #systemCategoryList) ifTrue: [(dropItem _ dstListMorph potentialDropItem) ifNotNil: [(self package , '-' , dropItem) asSymbol]] ifFalse: [self selectedSystemCategoryName]! ! !ScrollPane methodsFor: 'scrolling' stamp: 'ls 7/7/2000 17:27'! 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) <= bounds height ]) ifTrue:[ "already visible"^self ]. range _ self leftoverScrollRange. scrollBar value: (range > 0 ifTrue: [((aRectangle top) / self leftoverScrollRange) truncateTo: scrollBar scrollDelta] ifFalse: [0]). scroller offset: -3 @ (range * scrollBar value).! ! !PluggableListMorph methodsFor: 'accessing' stamp: 'ls 5/15/2001 22:31'! highlightSelector: aSelector self setProperty: #highlightSelector toValue: aSelector. self updateList! ! !PluggableListMorph methodsFor: 'accessing' stamp: 'ls 5/17/2001 20:31'! rowAtLocation: aPoint "Return the row at the given point or 0 if outside" | pointInListMorphCoords | pointInListMorphCoords := (self scroller transformFrom: self) transform: aPoint. ^self listMorph rowAtLocation: pointInListMorphCoords.! ! !PluggableListMorph methodsFor: 'drag and drop' stamp: 'ls 6/22/2001 23:56'! 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 resetPotentialDropRow. evt hand releaseMouseFocus: self. Cursor normal show. ! ! !PluggableListMorph methodsFor: 'drag and drop' stamp: 'ls 6/23/2001 00:01'! potentialDropItem "return the item that the most recent drop hovered over, or nil if there is no potential drop target" self potentialDropRow = 0 ifTrue: [ ^self ]. ^self getListItem: self potentialDropRow! ! !PluggableListMorph methodsFor: 'drag and drop' stamp: 'ls 6/23/2001 00:10'! potentialDropRow "return the row of the item that the most recent drop hovered over, or 0 if there is no potential drop target" ^potentialDropRow ifNil: [ 0 ]. ! ! !PluggableListMorph methodsFor: 'drag and drop' stamp: 'ls 6/23/2001 00:01'! resetPotentialDropRow potentialDropRow ifNotNil: [ potentialDropRow ~= 0 ifTrue: [ potentialDropRow _ 0. self changed. ] ]! ! !PluggableListMorph methodsFor: 'drag and drop' stamp: 'ls 6/22/2001 22:02'! startDrag: evt | ddm draggedRow draggedItemMorph | draggedRow := 0. self dragEnabled ifTrue:[ draggedRow := self rowAtLocation: evt position]. (draggedRow = 0 or:[evt hand hasSubmorphs]) ifTrue: [^self]. model okToChange ifFalse: [ Cursor normal show. ^ self]. "No change if model is locked" draggedItemMorph := StringMorph contents: (self getListItem: draggedRow). ddm _ TransferMorph withPassenger: (self model dragPassengerFor: draggedItemMorph inMorph: self) from: self. ddm dragTransferType: (self model dragTransferTypeForMorph: self). Preferences dragNDropWithAnimation ifTrue: [self model dragAnimationFor: draggedItemMorph transferMorph: ddm]. evt hand grabMorph: ddm. evt hand releaseMouseFocus: self.! ! !PluggableListMorph methodsFor: 'drawing' stamp: 'ls 5/17/2001 20:53'! highlightSelection! ! !PluggableListMorph methodsFor: 'drawing' stamp: 'ls 5/17/2001 20:53'! unhighlightSelection ! ! !PluggableListMorph methodsFor: 'events' stamp: 'ls 5/16/2001 22:28'! doubleClick: event | index | doubleClickSelector isNil ifTrue: [^super doubleClick: event]. index _ self rowAtLocation: event position. index = 0 ifTrue: [^super doubleClick: event]. "selectedMorph ifNil: [self setSelectedMorph: aMorph]." ^ self model perform: doubleClickSelector! ! !PluggableListMorph methodsFor: 'events' stamp: 'ls 10/14/2001 13:08'! handleBasicKeys: aBoolean "set whether the list morph should handle basic keys like arrow keys, or whether everything should be passed to the model" handlesBasicKeys _ aBoolean! ! !PluggableListMorph methodsFor: 'events' stamp: 'ls 10/14/2001 13:09'! handlesBasicKeys " if ya don't want the list to automatically handle non-modifier key (excluding shift key) input, return false" ^ handlesBasicKeys ifNil: [ true ]! ! !PluggableListMorph methodsFor: 'events' stamp: 'ls 10/14/2001 13:28'! mouseDown: evt | selectors row | evt yellowButtonPressed "First check for option (menu) click" ifTrue: [^ self yellowButtonActivity: evt shiftPressed]. row _ self rowAtLocation: evt position. row = 0 ifTrue: [^super mouseDown: evt]. "self dragEnabled ifTrue: [aMorph highlightForMouseDown]." selectors _ Array with: #click: with: (doubleClickSelector ifNotNil:[#doubleClick:]) with: nil with: (self dragEnabled ifTrue:[#startDrag:] ifFalse:[nil]). evt hand waitForClicksOrDrag: self event: evt selectors: selectors threshold: 10 "pixels".! ! !PluggableListMorph methodsFor: 'events' stamp: 'ls 6/22/2001 23:58'! mouseEnterDragging: evt (evt hand hasSubmorphs and:[self dropEnabled]) ifFalse: ["no d&d" ^super mouseEnterDragging: evt]. (self wantsDroppedMorph: evt hand firstSubmorph event: evt ) ifTrue:[ potentialDropRow _ self rowAtLocation: evt position. evt hand newMouseFocus: self. self changed. "above is ugly but necessary for now" ]. ! ! !PluggableListMorph methodsFor: 'events' stamp: 'ls 6/22/2001 23:56'! mouseLeaveDragging: anEvent (self dropEnabled and:[anEvent hand hasSubmorphs]) ifFalse: ["no d&d" ^ super mouseLeaveDragging: anEvent]. self resetPotentialDropRow. anEvent hand releaseMouseFocus: self. "above is ugly but necessary for now" ! ! !PluggableListMorph methodsFor: 'events' stamp: 'ls 6/22/2001 23:55'! mouseMove: evt (self dropEnabled and:[evt hand hasSubmorphs]) ifFalse:[^super mouseMove: evt]. potentialDropRow ifNotNil:[ potentialDropRow = (self rowAtLocation: evt position) ifTrue:[^self]. ]. self mouseLeaveDragging: evt. (self containsPoint: evt position) ifTrue:[self mouseEnterDragging: evt].! ! !PluggableListMorph methodsFor: 'events' stamp: 'ls 6/22/2001 22:49'! mouseUp: event "The mouse came up within the list; take appropriate action" | row | row _ self rowAtLocation: event position. "aMorph ifNotNil: [aMorph highlightForMouseDown: false]." model okToChange ifFalse: [^ self]. (autoDeselect == false and: [row == 0]) ifTrue: [^ self]. "work-around the no-mans-land bug" "No change if model is locked" ((autoDeselect == nil or: [autoDeselect]) and: [row == self selectionIndex]) ifTrue: [self changeModelSelection: 0] ifFalse: [self changeModelSelection: row]. Cursor normal show. ! ! !PluggableListMorph methodsFor: 'geometry' stamp: 'ls 5/17/2001 21:00'! extent: newExtent super extent: newExtent. self listMorph width: (self width - 7 max: 2) "I'm not sure what exactly the -7 should be -ls"! ! !PluggableListMorph methodsFor: 'geometry' stamp: 'ls 5/17/2001 21:01'! scrollDeltaHeight "Return the increment in pixels which this pane should be scrolled." ^ self font height! ! !PluggableListMorph methodsFor: 'initialization' stamp: 'ls 5/15/2001 22:21'! font ^ self listMorph font ! ! !PluggableListMorph methodsFor: 'initialization' stamp: 'ls 5/15/2001 22:21'! font: aFontOrNil self listMorph font: aFontOrNil. ! ! !PluggableListMorph methodsFor: 'initialization' stamp: 'ls 8/19/2001 14:15'! getListElementSelector: aSymbol "specify a selector that can be used to obtain a single element in the underlying list" getListElementSelector := aSymbol. list := nil. "this cache will not be updated if getListElementSelector has been specified, so go ahead and remove it"! ! !PluggableListMorph methodsFor: 'initialization' stamp: 'ls 2/9/2002 01:03'! getListSelector: sel "Set the receiver's getListSelector as indicated, and trigger a recomputation of the list" getListSelector _ sel. self changed. self updateList.! ! !PluggableListMorph methodsFor: 'initialization' stamp: 'ls 5/22/2001 18:21'! getListSizeSelector: aSymbol "specify a selector that can be used to specify the list's size" getListSizeSelector := aSymbol! ! !PluggableListMorph methodsFor: 'initialization' stamp: 'ls 2/5/2004 16:29'! list: listOfStrings "lex doesn't think this is used any longer, but is not yet brave enough to remove it. It should be removed eventually" "Set the receiver's list as specified" | morphList h loc index converter item aSelector textColor font | 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]. converter _ self valueOfProperty: #itemConversionMethod. converter ifNil: [converter _ #asStringOrText]. textColor _ self valueOfProperty: #textColor. morphList _ list collect: [:each | | stringMorph | item _ each. item _ item perform: converter. stringMorph _ item isText ifTrue: [StringMorph contents: item font: font emphasis: (item emphasisAt: 1)] ifFalse: [StringMorph contents: item font: font]. textColor ifNotNil: [ stringMorph color: textColor ]. stringMorph ]. (aSelector _ self valueOfProperty: #balloonTextSelectorForSubMorphs) ifNotNil: [morphList do: [:m | m balloonTextSelector: aSelector]]. 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: 'initialization' stamp: 'ls 5/15/2001 22:31'! on: anObject list: getListSel selected: getSelectionSel changeSelected: setSelectionSel menu: getMenuSel keystroke: keyActionSel self model: anObject. getListSelector _ getListSel. getIndexSelector _ getSelectionSel. setIndexSelector _ setSelectionSel. getMenuSelector _ getMenuSel. keystrokeActionSelector _ keyActionSel. autoDeselect _ true. self borderWidth: 1. self updateList. self selectionIndex: self getCurrentSelectionIndex. self initForKeystrokes! ! !PluggableListMorph methodsFor: 'initialization' stamp: 'ls 2/5/2004 18:02'! textColor: aColor "Set my default text color." self setProperty: #textColor toValue: aColor. self listMorph color: aColor.! ! !PluggableListMorph methodsFor: 'model access' stamp: 'ls 6/23/2001 00:45'! basicKeyPressed: aChar | oldSelection nextSelection max milliSeconds nextSelectionList nextSelectionText | nextSelection _ oldSelection _ self getCurrentSelectionIndex. max _ self maximumSelection. milliSeconds _ Time millisecondClockValue. milliSeconds - lastKeystrokeTime > 300 ifTrue: ["just use the one current character for selecting" lastKeystrokes _ '']. lastKeystrokes _ lastKeystrokes , aChar asLowercase asString. lastKeystrokeTime _ milliSeconds. nextSelectionList _ OrderedCollection newFrom: (self getList copyFrom: oldSelection + 1 to: max). nextSelectionList addAll: (self getList copyFrom: 1 to: oldSelection). "Get rid of blanks and style used in some lists" nextSelectionText _ nextSelectionList detect: [:a | a asString withBlanksTrimmed asLowercase beginsWith: lastKeystrokes] ifNone: [^ self flash"match not found"]. model okToChange ifFalse: [^ self]. nextSelection _ self getList findFirst: [:a | a == nextSelectionText]. "No change if model is locked" oldSelection == nextSelection ifTrue: [^ self flash]. ^ self changeModelSelection: nextSelection! ! !PluggableListMorph methodsFor: 'model access' stamp: 'ls 8/19/2001 14:16'! getList "Answer the list to be displayed. Caches the returned list in the 'list' ivar" getListSelector == nil ifTrue: [^ #()]. list _ model perform: getListSelector. list == nil ifTrue: [^ #()]. list _ list collect: [ :item | item asStringOrText ]. ^ list! ! !PluggableListMorph methodsFor: 'model access' stamp: 'ls 7/1/2001 10:39'! getListItem: index "get the index-th item in the displayed list" getListElementSelector ifNotNil: [ ^(model perform: getListElementSelector with: index) asStringOrText ]. list ifNotNil: [ ^list at: index ]. ^self getList at: index! ! !PluggableListMorph methodsFor: 'model access' stamp: 'ls 5/17/2001 22:04'! getListSize "return the current number of items in the displayed list" getListSizeSelector ifNotNil: [ ^model perform: getListSizeSelector ]. ^self getList size! ! !PluggableListMorph methodsFor: 'model access' stamp: 'ls 6/10/2001 12:26'! itemSelectedAmongMultiple: index "return whether the index-th row is selected. Always false in PluggableListMorph, but sometimes true in PluggableListMorphOfMany" ^false! ! !PluggableListMorph methodsFor: 'selection' stamp: 'ls 5/17/2001 23:06'! maximumSelection ^ self getListSize! ! !PluggableListMorph methodsFor: 'selection' stamp: 'ls 6/16/2001 14:15'! scrollSelectionIntoView "make sure that the current selection is visible" | row | row := self getCurrentSelectionIndex. row = 0 ifTrue: [ ^ self ]. self scrollToShow: (self listMorph drawBoundsForRow: row)! ! !PluggableListMorph methodsFor: 'selection' stamp: 'ls 8/19/2001 14:20'! selectedMorph "this doesn't work with the LargeLists patch!! Use #selectionIndex and #selection instead." ^self scroller submorphs at: self selectionIndex! ! !PluggableListMorph methodsFor: 'selection' stamp: 'ls 4/18/2002 00:35'! selectedMorph: aMorph "this shouldn't be used any longer" "self isThisEverCalled ." Smalltalk beep. true ifTrue: [ ^self ]. ! ! !PluggableListMorph methodsFor: 'selection' stamp: 'ls 8/19/2001 14:29'! selection self selectionIndex = 0 ifTrue: [ ^nil ]. list ifNotNil: [ ^list at: self selectionIndex ]. ^ self getListItem: self selectionIndex! ! !PluggableListMorph methodsFor: 'selection' stamp: 'ls 6/22/2001 22:49'! selection: item "Called from outside to request setting a new selection." self selectionIndex: (self getList indexOf: item)! ! !PluggableListMorph methodsFor: 'selection' stamp: 'ls 6/22/2001 22:49'! selectionIndex "return the index we have currently selected, or 0 if none" ^self listMorph selectedRow ifNil: [ 0 ]! ! !PluggableListMorph methodsFor: 'selection' stamp: 'ls 6/22/2001 22:50'! selectionIndex: index "Called internally to select the index-th item." | row | self unhighlightSelection. row := index ifNil: [ 0 ]. row := row min: self getListSize. "make sure we don't select past the end" self listMorph selectedRow: row. self highlightSelection. self scrollSelectionIntoView.! ! !PluggableListMorph methodsFor: 'updating' stamp: 'ls 5/15/2001 22:31'! update: aSymbol "Refer to the comment in View|update:." aSymbol == getListSelector ifTrue: [self updateList. ^ self]. aSymbol == getIndexSelector ifTrue: [self selectionIndex: self getCurrentSelectionIndex. ^ self]. ! ! !PluggableListMorph methodsFor: 'updating' stamp: 'ls 6/22/2001 23:56'! updateList | index | "the list has changed -- update from the model" self listMorph listChanged. self setScrollDeltas. scrollBar setValue: 0.0. index _ self getCurrentSelectionIndex. self resetPotentialDropRow. self selectionIndex: index. ! ! !PluggableListMorph methodsFor: 'updating' stamp: 'ls 8/19/2001 14:36'! verifyContents "Verify the contents of the receiver, reconstituting if necessary. Called whenever window is reactivated, to react to possible structural changes. Also called periodically in morphic if the smartUpdating preference is true" | newList existingSelection anIndex oldList | oldList _ list ifNil: [ #() ]. newList _ self getList. ((oldList == newList) "fastest" or: [oldList = newList]) ifTrue: [^ self]. self flash. "list has changed beneath us; give the user a little visual feedback that the contents of the pane are being updated." existingSelection _ self selectionIndex > 0 ifTrue: [ oldList at: self selectionIndex ] ifFalse: [ nil ]. self updateList. (existingSelection notNil and: [(anIndex _ list indexOf: existingSelection asStringOrText ifAbsent: [nil]) notNil]) ifTrue: [model noteSelectionIndex: anIndex for: getListSelector. self selectionIndex: anIndex] ifFalse: [self changeModelSelection: 0]! ! !PluggableListMorph methodsFor: 'as yet unclassified' stamp: 'ls 2/5/2004 18:01'! listMorph listMorph ifNil: [ "crate this lazily, in case the morph is legacy" listMorph := self listMorphClass new. listMorph listSource: self. listMorph width: self scroller width. listMorph color: self textColor ]. listMorph owner ~~ self scroller ifTrue: [ "list morph needs to be installed. Again, it's done this way to accomodate legacy PluggableListMorphs" self scroller removeAllMorphs. self scroller addMorph: listMorph ]. ^listMorph! ! !PluggableListMorph methodsFor: 'as yet unclassified' stamp: 'ls 5/17/2001 09:04'! listMorphClass ^LazyListMorph! ! !ListComponent methodsFor: 'model access' stamp: 'ls 5/17/2001 23:07'! changeModelSelection: anInteger "Change the model's selected item index to be anInteger." setIndexSelector ifNil: ["If model is not hooked up to index, then we won't get an update, so have to do it locally." self selectionIndex: anInteger] ifNotNil: [model perform: setIndexSelector with: anInteger]. selectedItem _ anInteger = 0 ifTrue: [nil] ifFalse: [self getListItem: anInteger]. setSelectionSelector ifNotNil: [model perform: setSelectionSelector with: selectedItem]! ! !PluggableListMorphByItem methodsFor: 'initialization' stamp: 'ls 8/19/2001 14:52'! list: arrayOfStrings "Set the receivers items to be the given list of strings." "Note: the instance variable 'items' holds the original list. The instance variable 'list' is a paragraph constructed from this list." "NOTE: this is no longer true; list is a real list, and itemList is no longer used. And this method shouldn't be called, incidentally." self isThisEverCalled . itemList _ arrayOfStrings. ^ super list: arrayOfStrings! ! !PluggableListMorphByItem methodsFor: 'model access' stamp: 'ls 8/19/2001 15:58'! changeModelSelection: anInteger "Change the model's selected item to be the one at the given index." | item | setIndexSelector ifNotNil: [ item _ (anInteger = 0 ifTrue: [nil] ifFalse: [itemList at: anInteger]). model perform: setIndexSelector with: item]. self update: getIndexSelector. ! ! !PluggableListMorphByItem methodsFor: 'model access' stamp: 'ls 8/19/2001 14:51'! getCurrentSelectionIndex "Answer the index of the current selection." | item | getIndexSelector == nil ifTrue: [^ 0]. item _ model perform: getIndexSelector. ^ list findFirst: [ :x | x = item] ! ! !PluggableListMorphByItem methodsFor: 'as yet unclassified' stamp: 'ls 8/19/2001 15:57'! getList "cache the raw items in itemList" itemList := getListSelector ifNil: [ #() ] ifNotNil: [ model perform: getListSelector ]. ^super getList! ! !PluggableListMorphOfMany methodsFor: 'event handling' stamp: 'ls 7/15/2002 11:16'! mouseDown: event | oldIndex oldVal row | event yellowButtonPressed ifTrue: [^ self yellowButtonActivity: event shiftPressed]. row := self rowAtLocation: event position. row = 0 ifTrue: [^super mouseDown: event]. model okToChange ifFalse: [^ self]. "No change if model is locked" "Set meaning for subsequent dragging of selection" dragOnOrOff _ (self listSelectionAt: row) not. oldIndex _ self getCurrentSelectionIndex. oldIndex ~= 0 ifTrue: [oldVal _ self listSelectionAt: oldIndex]. "Set or clear new primary selection (listIndex)" dragOnOrOff ifTrue: [self changeModelSelection: row] ifFalse: [self changeModelSelection: 0]. "Need to restore the old one, due to how model works, and set new one." oldIndex ~= 0 ifTrue: [self listSelectionAt: oldIndex put: oldVal]. self listSelectionAt: row put: dragOnOrOff. "event hand releaseMouseFocus: aMorph." "aMorph changed"! ! !PluggableListMorphOfMany methodsFor: 'event handling' stamp: 'nk 10/14/2003 22:19'! mouseMove: event "The mouse has moved, as characterized by the event provided. Adjust the scrollbar, and alter the selection as appropriate" | oldIndex oldVal row | event position y < self top ifTrue: [scrollBar scrollUp: 1. row := self rowAtLocation: scroller topLeft + (1 @ 1)] ifFalse: [row := event position y > self bottom ifTrue: [scrollBar scrollDown: 1. self rowAtLocation: scroller bottomLeft + (1 @ -1)] ifFalse: [ self rowAtLocation: event position]]. row = 0 ifTrue: [^super mouseDown: event]. model okToChange ifFalse: [^self]. "No change if model is locked" dragOnOrOff ifNil: ["Was not set at mouse down, which means the mouse must have gone down in an area where there was no list item" dragOnOrOff := (self listSelectionAt: row) not]. "Set meaning for subsequent dragging of selection" oldIndex := self getCurrentSelectionIndex. oldIndex ~= 0 ifTrue: [oldVal := self listSelectionAt: oldIndex]. "Set or clear new primary selection (listIndex)" dragOnOrOff ifTrue: [self changeModelSelection: row] ifFalse: [self changeModelSelection: 0]. "Need to restore the old one, due to how model works, and set new one." oldIndex ~= 0 ifTrue: [self listSelectionAt: oldIndex put: oldVal]. self listSelectionAt: row put: dragOnOrOff. row changed! ! !PluggableListMorphOfMany methodsFor: 'model access' stamp: 'ls 6/10/2001 12:27'! itemSelectedAmongMultiple: index ^model listSelectionAt: index! ! !PluggableMessageCategoryListMorph methodsFor: 'as yet unclassified' stamp: 'ls 5/15/2001 22:32'! on: anObject list: getListSel selected: getSelectionSel changeSelected: setSelectionSel menu: getMenuSel keystroke: keyActionSel getRawListSelector: getRawSel. self model: anObject. getListSelector _ getListSel. getIndexSelector _ getSelectionSel. setIndexSelector _ setSelectionSel. getMenuSelector _ getMenuSel. keystrokeActionSelector _ keyActionSel. autoDeselect _ true. self borderWidth: 1. getRawListSelector _ getRawSel. self updateList. self selectionIndex: self getCurrentSelectionIndex. self initForKeystrokes! ! !PluggableMessageCategoryListMorph methodsFor: 'model access' stamp: 'ls 8/19/2001 15:35'! getList "Differs from the generic in that here we obtain and cache the raw list, then cons it together with the special '-- all --' item to produce the list to be used in the browser. This special handling is done in order to avoid excessive and unnecessary reformulation of the list in the step method" getRawListSelector == nil ifTrue: ["should not happen!!" priorRawList _ nil. ^ #()]. model classListIndex = 0 ifTrue: [^ priorRawList _ list _ Array new]. priorRawList _ model perform: getRawListSelector. list := (Array with: ClassOrganizer allCategory), priorRawList. ^list! ! !PluggableMessageCategoryListMorph methodsFor: 'updating' stamp: 'ls 8/19/2001 14:26'! verifyContents | newList existingSelection anIndex newRawList | (model editSelection == #editComment) ifTrue: [^ self]. model classListIndex = 0 ifTrue: [^ self]. newRawList _ model perform: getRawListSelector. newRawList == priorRawList ifTrue: [^ self]. "The usual case; very fast" priorRawList _ newRawList. newList _ (Array with: ClassOrganizer allCategory), priorRawList. list = newList ifTrue: [^ self]. self flash. "could get annoying, but hell" existingSelection _ self selection. self updateList. (anIndex _ newList indexOf: existingSelection ifAbsent: [nil]) ifNotNil: [model noteSelectionIndex: anIndex for: getListSelector. self selectionIndex: anIndex] ifNil: [self changeModelSelection: 0]! ! !PluggableMultiColumnListMorph methodsFor: 'accessing' stamp: 'ls 5/18/2001 10:32'! getListRow: row "return the strings that should appear in the requested row" getListElementSelector ifNotNil: [ ^model perform: getListElementSelector with: row ]. ^self getList collect: [ :l | l at: row ]! ! !PluggableMultiColumnListMorph methodsFor: 'accessing' stamp: 'ls 5/17/2001 23:03'! getListSize | l | getListSizeSelector ifNotNil: [ ^model perform: getListSizeSelector ]. l := self getList. l isEmpty ifTrue: [ ^ 0 ]. ^l first size! ! !PluggableMultiColumnListMorph methodsFor: 'accessing' stamp: 'ls 5/17/2001 20:01'! listMorphClass ^MulticolumnLazyListMorph! ! !PluggableMultiColumnListMorph methodsFor: 'initialization' stamp: 'ls 5/15/2001 22:22'! createMorphicListsFrom: arrayOfLists | array | array _ Array new: arrayOfLists size. 1 to: arrayOfLists size do: [:arrayIndex | array at: arrayIndex put: ( (arrayOfLists at: arrayIndex) collect: [:item | item isText ifTrue: [StringMorph contents: item font: self font emphasis: (item emphasisAt: 1)] ifFalse: [StringMorph contents: item font: self font]]) ]. ^array! ! !PluggableMultiColumnListMorph methodsFor: 'initialization' stamp: 'ls 5/17/2001 21:16'! list: arrayOfLists | listOfStrings | lists _ arrayOfLists. scroller removeAllMorphs. listOfStrings _ arrayOfLists == nil ifTrue: [Array new] ifFalse: [ arrayOfLists isEmpty ifFalse: [ arrayOfLists at: 1]]. list _ listOfStrings ifNil: [Array new]. self listMorph listChanged.. self setScrollDeltas. scrollBar setValue: 0.0! ! !PluggableMultiColumnListMorph methodsFor: 'selection' stamp: 'ls 5/16/2001 22:24'! highlightSelection ^self! ! !PluggableMultiColumnListMorph methodsFor: 'selection' stamp: 'ls 5/16/2001 22:23'! unhighlightSelection ^self! ! !PluggableMultiColumnListMorph methodsFor: 'model access' stamp: 'ls 11/14/2002 13:13'! basicKeyPressed: aChar "net supported for multi-column lists; which column should be used?!! The issue is that the base class implementation uses getList expecting a single collectino to come back instead of several of them" ^self! ! !PluggableMultiColumnListMorph methodsFor: 'model access' stamp: 'ls 7/12/2001 23:24'! getList "fetch and answer the lists to be displayed" getListSelector == nil ifTrue: [^ #()]. list _ model perform: getListSelector. list == nil ifTrue: [^ #()]. list _ list collect: [ :column | column collect: [ :item | item asStringOrText ] ]. ^ list! ! !PluggableMultiColumnListMorphByItem methodsFor: 'initialization' stamp: 'ls 8/19/2001 14:55'! list: arrayOfStrings "Set the receivers items to be the given list of strings." "Note: the instance variable 'items' holds the original list. The instance variable 'list' is a paragraph constructed from this list." "NO LONGER TRUE. list is a real list, and listItems is obsolete." self isThisEverCalled . itemList _ arrayOfStrings first. ^ super list: arrayOfStrings! ! !PluggableMultiColumnListMorphByItem methodsFor: 'model access' stamp: 'ls 8/19/2001 14:57'! changeModelSelection: anInteger "Change the model's selected item to be the one at the given index." | item | setIndexSelector ifNotNil: [item _ anInteger = 0 ifFalse: [list first at: anInteger]. model perform: setIndexSelector with: item]. self update: getIndexSelector! ! !PluggableMultiColumnListMorphByItem methodsFor: 'model access' stamp: 'ls 8/19/2001 15:11'! getCurrentSelectionIndex "Answer the index of the current selection." | item | getIndexSelector == nil ifTrue: [^ 0]. item _ model perform: getIndexSelector. ^ list first findFirst: [:x | x = item]! ! PluggableMultiColumnListMorph removeSelector: #drawOn:! PluggableMultiColumnListMorph removeSelector: #selectionIndex:! PluggableListMorph subclass: #PluggableMultiColumnListMorph instanceVariableNames: 'lists' classVariableNames: '' poolDictionaries: '' category: 'Morphic-Windows'! PluggableListMorphOfMany removeSelector: #drawOn:! PluggableListMorph removeSelector: #drawOn:! PluggableListMorph removeSelector: #potentialDropMorph! PluggableListMorph removeSelector: #potentialDropMorph:! PluggableListMorph removeSelector: #resetPotentialDropMorph! ScrollPane subclass: #PluggableListMorph instanceVariableNames: 'list getListSelector getListSizeSelector getListElementSelector getIndexSelector setIndexSelector keystrokeActionSelector autoDeselect lastKeystrokeTime lastKeystrokes lastClickTime doubleClickSelector handlesBasicKeys potentialDropRow listMorph' classVariableNames: '' poolDictionaries: '' category: 'Morphic-Windows'! !LazyListMorph reorganize! ('initialization' initialize listSource:) ('list management' drawBoundsForRow: listChanged rowAtLocation: selectRow: selectedRow selectedRow: unselectRow:) ('drawing' adjustHeight bottomVisibleRowForCanvas: colorForRow: display:atRow:on: drawBackgroundForMulti:on: drawBackgroundForPotentialDrop:on: drawOn: drawSelectionOn: font font: highlightPotentialDropRow:on: topVisibleRowForCanvas:) ('list access' getListItem: getListSize item:) ('temp') !