[Pkg] The Trunk: Morphic-cmm.578.mcz

commits at source.squeak.org commits at source.squeak.org
Tue Nov 8 02:52:49 UTC 2011


Chris Muller uploaded a new version of Morphic to project The Trunk:
http://source.squeak.org/trunk/Morphic-cmm.578.mcz

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

Name: Morphic-cmm.578
Author: cmm
Time: 11 September 2011, 1:04:43.582 pm
UUID: e71c6e97-3e60-498b-897b-2d5fb9ad9930
Ancestors: Morphic-cmm.577

- Change operation of the backspace key so that it returns to the prior selection before filtering started.  Enter selects the new selection.
- Fixed drag of message from a filtered list.

=============== Diff against Morphic-cmm.571 ===============

Item was changed:
  ScrollPane subclass: #PluggableListMorph
+ 	instanceVariableNames: 'list getListSelector getListSizeSelector getListElementSelector getIndexSelector setIndexSelector keystrokeActionSelector autoDeselect lastKeystrokeTime lastKeystrokes lastClickTime doubleClickSelector handlesBasicKeys potentialDropRow listMorph hScrollRangeCache keystrokePreviewSelector priorSelection'
+ 	classVariableNames: 'FilterableLists'
- 	instanceVariableNames: 'list getListSelector getListSizeSelector getListElementSelector getIndexSelector setIndexSelector keystrokeActionSelector autoDeselect lastKeystrokeTime lastKeystrokes lastClickTime doubleClickSelector handlesBasicKeys potentialDropRow listMorph hScrollRangeCache keystrokePreviewSelector'
- 	classVariableNames: ''
  	poolDictionaries: ''
  	category: 'Morphic-Pluggable Widgets'!
  
+ !PluggableListMorph commentStamp: 'cmm 8/21/2011 23:37' prior: 0!
+ When a PluggableListMorph is in focus, type in a letter (or several letters quickly) to go to the next item that begins with that letter (if FilterableLists is false).
- !PluggableListMorph commentStamp: '<historical>' prior: 0!
- ...
  
- When a PluggableListMorph is in focus, type in a letter (or several
- letters quickly) to go to the next item that begins with that letter.
  Special keys (up, down, home, etc.) are also supported.!

Item was added:
+ ----- Method: PluggableListMorph class>>filterableLists (in category 'preferences') -----
+ filterableLists
+ 	<preference: 'Filterable Lists'
+ 		category: 'scrolling'
+ 		description: 'When true, using the keyboard on a list will filter it rather than scroll.  Pressing enter or backspace restores all items to the list.'
+ 		type: #Boolean>
+ 	^ FilterableLists ifNil: [ true ]!

Item was added:
+ ----- Method: PluggableListMorph class>>filterableLists: (in category 'preferences') -----
+ filterableLists: aBoolean
+ 	"When true, using the keyboard on a list will filter it rather than scroll.  Pressing enter or backspace restores all items to the list."
+ 	FilterableLists := aBoolean!

Item was changed:
  ----- Method: PluggableListMorph>>basicKeyPressed: (in category 'model access') -----
  basicKeyPressed: aChar 
- 
  	| milliseconds slowKeyStroke listSize newSelectionIndex oldSelectionIndex startIndex |
  	oldSelectionIndex := newSelectionIndex := self getCurrentSelectionIndex.
  	listSize := self getListSize.
  	milliseconds := Time millisecondClockValue.
+ 	slowKeyStroke := (Time
+ 		milliseconds: milliseconds
+ 		since: lastKeystrokeTime) > (self class filterableLists ifTrue: [500] ifFalse: [ 300 ]).
- 	slowKeyStroke := (Time milliseconds: milliseconds since: lastKeystrokeTime) > 300.
  	lastKeystrokeTime := milliseconds.
  	slowKeyStroke
+ 		ifTrue:
+ 			[ self class filterableLists ifTrue: [ self hasFilter ifFalse: [ priorSelection := self modelIndexFor: self selectionIndex] ].
+ 			"forget previous keystrokes and search in following elements"
- 		ifTrue: ["forget previous keystrokes and search in following elements"
  			lastKeystrokes := aChar asLowercase asString.
+ 			newSelectionIndex := newSelectionIndex \\ listSize + 1.
+ 			self class filterableLists ifTrue: [ list := self getFullList ] ]
+ 		ifFalse: [ "append quick keystrokes but don't move selection if it still matches"
- 			newSelectionIndex := newSelectionIndex \\ listSize + 1 ]
- 		ifFalse: ["append quick keystrokes but don't move selection if it still matches"
  			lastKeystrokes := lastKeystrokes , aChar asLowercase asString ].
  	"No change if model is locked"
+ 	model okToChange ifFalse: [ ^ self ].
+ 	self class filterableLists
+ 		ifTrue:
+ 			[ self
+ 				 filterList ;
+ 				 updateList.
+ 			newSelectionIndex := self modelIndexFor: 1 ]
+ 		ifFalse:
+ 			[ startIndex := newSelectionIndex.
+ 			listSize := self getListSize.
+ 			[ (self getListItem: newSelectionIndex) asString withBlanksTrimmed asLowercase beginsWith: lastKeystrokes ] whileFalse:
+ 				[ (newSelectionIndex := newSelectionIndex \\ listSize + 1) = startIndex ifTrue: [ ^ self flash"Not in list." ] ].
+ 			newSelectionIndex = oldSelectionIndex ifTrue: [ ^ self flash ] ].
+ 	(self hasFilter and: [(self getCurrentSelectionIndex = newSelectionIndex) not]) ifTrue:
+ 		[self changeModelSelection: newSelectionIndex]!
- 	model okToChange ifFalse: [ ^self ].
- 	"Get rid of blanks and style used in some lists"
- 	startIndex := newSelectionIndex.
- 	[
- 		(self getListItem: newSelectionIndex) asString
- 			withBlanksTrimmed asLowercase beginsWith: lastKeystrokes ]
- 		whileFalse: [
- 			(newSelectionIndex := newSelectionIndex \\ listSize + 1) = startIndex ifTrue: [
- 				^self flash. "Not in list." ] ].
- 	newSelectionIndex = oldSelectionIndex ifTrue: [ ^self flash ]. "Same selection."
- 	^self changeModelSelection: newSelectionIndex!

Item was added:
+ ----- Method: PluggableListMorph>>filterList (in category 'filtering') -----
+ filterList
+ 	self hasFilter
+ 		ifTrue:
+ 			[ | frontMatching substringMatching newList |
+ 			self indicateFiltered.
+ 			frontMatching := OrderedCollection new.
+ 			substringMatching := OrderedCollection new.
+ 			list withIndexDo:
+ 				[ : each : n | | foundPos |
+ 				foundPos := each asString
+ 					findString: lastKeystrokes
+ 					startingAt: 1
+ 					caseSensitive: false.
+ 				foundPos = 1
+ 					ifTrue: [ frontMatching add: each ]
+ 					ifFalse:
+ 						[ foundPos = 0 ifFalse: [ substringMatching add: each ] ] ].
+ 			newList := frontMatching , substringMatching.
+ 			newList
+ 				ifEmpty:
+ 					[ lastKeystrokes := lastKeystrokes allButLast: 1.
+ 					self
+ 						 flash ;
+ 						 filterList ]
+ 				ifNotEmpty: [ list := newList ] ]
+ 		ifFalse: [ self indicateUnfiltered ]!

Item was added:
+ ----- Method: PluggableListMorph>>getFullList (in category 'model access') -----
+ getFullList
+ 	"The full, unfiltered list."
+ 	^ model perform: getListSelector!

Item was changed:
  ----- Method: PluggableListMorph>>getList (in category 'model access') -----
  getList
  	"Answer the list to be displayed.  Caches the returned list in the 'list' ivar"
+ 	getListSelector == nil ifTrue: [ ^ Array empty ].
+ 	list := self getFullList.
+ 	self class filterableLists ifTrue: [ self filterList ].
- 	getListSelector == nil ifTrue: [ ^ #() ].
- 	list := model perform: getListSelector.
  	^ list ifNil: [ Array empty ]!

Item was added:
+ ----- Method: PluggableListMorph>>hasFilter (in category 'filtering') -----
+ hasFilter
+ 	^ lastKeystrokes isEmptyOrNil not!

Item was added:
+ ----- Method: PluggableListMorph>>indicateFiltered (in category 'filtering') -----
+ indicateFiltered
+ 	self color: Color red muchLighter muchLighter!

Item was added:
+ ----- Method: PluggableListMorph>>indicateUnfiltered (in category 'filtering') -----
+ indicateUnfiltered
+ 	self color: Color white!

Item was added:
+ ----- Method: PluggableListMorph>>modelIndexFor: (in category 'selection') -----
+ modelIndexFor: selectionIndex 
+ 	"The model does not know anything about the receiver's filtering, so if I am filtered, we must determine the correct index by scanning the full list in the model."
+ 	^ (selectionIndex > 0 and: [ self hasFilter ])
+ 		ifTrue:
+ 			[ list
+ 				ifEmpty: [ 0 ]
+ 				ifNotEmpty: [ self getFullList indexOf: (self getListItem: selectionIndex) ] ]
+ 		ifFalse: [ selectionIndex ]!

Item was changed:
  ----- Method: PluggableListMorph>>mouseUp: (in category 'events') -----
  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].
  	"No change if model is locked"
  	row = self selectionIndex
  		ifTrue: [(autoDeselect ifNil: [true]) ifTrue:[row = 0 ifFalse: [self changeModelSelection: 0] ]]
+ 		ifFalse: [self changeModelSelection: (self modelIndexFor: row)].
- 		ifFalse: [self changeModelSelection: row].
  	Cursor normal show!

Item was added:
+ ----- Method: PluggableListMorph>>removeFilter (in category 'model access') -----
+ removeFilter
+ 	lastKeystrokes := String empty.
+ 	list := nil!

Item was changed:
  ----- Method: PluggableListMorph>>scrollSelectionIntoView (in category 'selection') -----
  scrollSelectionIntoView
  	"make sure that the current selection is visible"
  	| row |
+ 	row := self uiIndexFor: self getCurrentSelectionIndex.
- 	row := self getCurrentSelectionIndex.
  	row = 0 ifTrue: [ ^ self ].
  	self scrollToShow: (self listMorph drawBoundsForRow: row)!

Item was changed:
  ----- Method: PluggableListMorph>>selectedMorph: (in category 'selection') -----
  selectedMorph: aMorph 
  	"this shouldn't be used any longer"
  
+ 	self isThisEverCalled .
- 	"self isThisEverCalled ."
- 
- 	Beeper  beep.
  	true ifTrue: [^self]!

Item was changed:
  ----- Method: PluggableListMorph>>setSelectedMorph: (in category 'selection') -----
+ setSelectedMorph: aMorph 
+ 	self changeModelSelection: (self modelIndexFor: (scroller submorphs indexOf: aMorph))!
- setSelectedMorph: aMorph
- 	self changeModelSelection: (scroller submorphs indexOf: aMorph)!

Item was changed:
  ----- Method: PluggableListMorph>>specialKeyPressed: (in category 'model access') -----
  specialKeyPressed: asciiValue
  	"A special key with the given ascii-value was pressed; dispatch it"
- 
  	| oldSelection nextSelection max howManyItemsShowing |
+ 	(#(8 13) includes: asciiValue) ifTrue:
+ 		[ "backspace key - clear the filter, restore the list with the selection" 
+ 		self removeFilter.
+ 		priorSelection ifNotNil: [ asciiValue = 8 ifTrue: [ self changeModelSelection: priorSelection ] ].
+ 		^ self updateList ].
  	asciiValue = 27 ifTrue: 
  		[" escape key"
  		^ ActiveEvent shiftPressed
  			ifTrue:
  				[ActiveWorld putUpWorldMenuFromEscapeKey]
  			ifFalse:
  				[self yellowButtonActivity: false]].
  
  	max := self maximumSelection.
  	max > 0 ifFalse: [^ self].
+ 	nextSelection := oldSelection := self selectionIndex.
- 	nextSelection := oldSelection := self getCurrentSelectionIndex.
  	asciiValue = 31 ifTrue: 
  		[" down arrow"
  		nextSelection := oldSelection + 1.
  		nextSelection > max ifTrue: [nextSelection := 1]].
  	asciiValue = 30 ifTrue: 
  		[" up arrow"
  		nextSelection := oldSelection - 1.
  		nextSelection < 1 ifTrue: [nextSelection := max]].
  	asciiValue = 1 ifTrue:
  		[" home"
  		nextSelection := 1].
  	asciiValue = 4 ifTrue:
  		[" end"
  		nextSelection := max].
  	howManyItemsShowing := self numSelectionsInView.
  	asciiValue = 11 ifTrue:
  		[" page up"
  		nextSelection := 1 max: oldSelection - howManyItemsShowing].
  	asciiValue = 12 ifTrue:
  		[" page down"
  		nextSelection := oldSelection + howManyItemsShowing min: max].
  	model okToChange ifFalse: [^ self].
  	"No change if model is locked"
  	oldSelection = nextSelection ifTrue: [^ self flash].
+ 	^ self changeModelSelection: (self modelIndexFor: nextSelection)!
- 	^ self changeModelSelection: nextSelection!

Item was removed:
- ----- Method: PluggableListMorph>>superDrawOn: (in category 'drawing') -----
- superDrawOn: aCanvas 
- 	super drawOn: aCanvas.
- !

Item was added:
+ ----- Method: PluggableListMorph>>uiIndexFor: (in category 'selection') -----
+ uiIndexFor: modelIndex 
+ 	"The model does not know anything about the receiver's filtering.  Answer the index in my (possibly filtered) list for modelIndex."
+ 	(modelIndex > 0 and: [ self hasFilter ])
+ 		ifTrue:
+ 			[ | selectedItem |
+ 			selectedItem := self getFullList at: modelIndex.
+ 			(list ifNil: [ self getList ]) withIndexDo:
+ 				[ : eachMatchingItem : n | eachMatchingItem = selectedItem ifTrue: [ ^ n ] ].
+ 			^ 0 ]
+ 		ifFalse: [ ^ modelIndex ]!

Item was changed:
  ----- Method: PluggableListMorph>>update: (in category 'updating') -----
  update: aSymbol 
  	"Refer to the comment in View|update:."
+ 	aSymbol == getListSelector ifTrue:
+ 		[ self updateList.
+ 		^ self ].
- 
- 	aSymbol == getListSelector ifTrue: 
- 		[self updateList.
- 		^ self].
  	aSymbol == getIndexSelector ifTrue:
+ 		[ | uiIndex modelIndex |
+ 		uiIndex := self uiIndexFor: (modelIndex := self getCurrentSelectionIndex).
+ 		self selectionIndex:
+ 			(uiIndex = 0
+ 				ifTrue:
+ 					[ "The filter is preventing us from selecting the item we want - remove it."
+ 					(list notNil and: [list size > 0]) ifTrue: [ self removeFilter ].
+ 					modelIndex ]
+ 				ifFalse: [ uiIndex ]).
+ 		^ self ]!
- 		[self selectionIndex: self getCurrentSelectionIndex.
- 		^ self].
- !

Item was changed:
  ----- Method: PluggableListMorph>>updateList (in category 'updating') -----
  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: (self uiIndexFor: index).
- 	self selectionIndex: index.
  !

Item was changed:
  ----- Method: PluggableListMorph>>verifyContents (in category 'updating') -----
  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 ifTrue: [ ^ self ].
  	existingSelection := self selectionIndex > 0 ifTrue: [ oldList at: self selectionIndex ] ifFalse: [ nil ].
  	self updateList.
+ 	(existingSelection notNil and: [(anIndex := self getFullList indexOf: existingSelection asStringOrText ifAbsent: [nil]) notNil])
- 	(existingSelection notNil and: [(anIndex := list indexOf: existingSelection asStringOrText ifAbsent: [nil]) notNil])
  		ifTrue:
  			[model noteSelectionIndex: anIndex for: getListSelector.
  			self selectionIndex: anIndex]
  		ifFalse:
  			[self changeModelSelection: 0]!

Item was changed:
  ----- Method: PluggableListMorphOfMany>>mouseDown: (in category 'event handling') -----
  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: (self modelIndexFor: row)]
- 		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"!

Item was changed:
  ----- Method: PluggableListMorphOfMany>>mouseMove: (in category 'event handling') -----
  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: (self modelIndexFor: row)]
- 		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!



More information about the Packages mailing list