[squeak-dev] The Trunk: Morphic-nice.534.mcz

commits at source.squeak.org commits at source.squeak.org
Sun May 8 11:49:58 UTC 2011


Nicolas Cellier uploaded a new version of Morphic to project The Trunk:
http://source.squeak.org/trunk/Morphic-nice.534.mcz

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

Name: Morphic-nice.534
Author: nice
Time: 8 May 2011, 1:48:33.956 pm
UUID: 8f3ceb61-7571-439a-add9-26e4284a7442
Ancestors: Morphic-cmm.533, Morphic-nice.531

minor refactorings: use #anySatisfy: #allSatisfy: #noneSatisfy: where it simplifies

=============== Diff against Morphic-cmm.533 ===============

Item was changed:
  ----- Method: CircleMorph>>initialize (in category 'parts bin') -----
  initialize
  	super initialize.
  	self extent: 40 at 40;
+ 		color: Color green lighter!
- 		color: Color green lighter;
- 		yourself!

Item was added:
+ ----- Method: FormCanvas>>translucentImage:at:sourceRect: (in category 'drawing-images') -----
+ translucentImage: aForm at: aPoint sourceRect: sourceRect
+ 	"Workaround because copying 16bits->32bits image does not fill the alpha channel"
+ 	super translucentImage: aForm at: aPoint sourceRect: sourceRect.
+ 	aForm isTranslucent ifFalse: [form fixAlpha]!

Item was changed:
  ----- Method: ListItemWrapper>>hasEquivalentIn: (in category 'as yet unclassified') -----
  hasEquivalentIn: aCollection
  
+ 	^aCollection anySatisfy: [ :each | 
+ 		each withoutListWrapper = item withoutListWrapper]!
- 	aCollection detect: [ :each | 
- 		each withoutListWrapper = item withoutListWrapper
- 	] ifNone: [^false].
- 	^true!

Item was changed:
  ----- Method: Morph>>hasSubmorphWithProperty: (in category 'submorphs-accessing') -----
  hasSubmorphWithProperty: aSymbol
+ 	^submorphs anySatisfy: [:m | m hasProperty: aSymbol]!
- 	submorphs detect: [:m | m hasProperty: aSymbol] ifNone: [^ false].
- 	^ true!

Item was changed:
  ----- Method: TextEditor>>explain (in category 'menu messages') -----
  explain
  	"Try to shed some light on what kind of entity the current selection is. 
  	The selection must be a single token or construct. Insert the answer after 
  	the selection. Send private messages whose names begin with 'explain' 
  	that return a string if they recognize the selection, else nil."
  
  	
  Cursor execute showWhile: 
  			[ | string numbers delimitors cgVars reply selectors tiVars symbol sorry |
  			sorry := '"Sorry, I can''t explain that.  Please select a single
  token, construct, or special character.'.
  			sorry := sorry , (morph canDiscardEdits
  							ifFalse: ['  Also, please cancel or accept."']
  							ifTrue: ['"']).
  			(string := self selection asString) isEmpty
  				ifTrue: [reply := '']
  				ifFalse: [string := self explainScan: string.
  					"Remove space, tab, cr"
  					"Temps and Instance vars need only test strings that are all letters"
+ 					(string allSatisfy: [:char | char isLetter or: [char isDigit]])
+ 						ifTrue: 
- 					(string detect: [:char | (char isLetter or: [char isDigit]) not]
- 						ifNone: []) ifNil: 
  							[tiVars := self explainTemp: string.
  							tiVars == nil ifTrue: [tiVars := self explainInst: string]].
  					(tiVars == nil and: [model respondsTo: #explainSpecial:])
  						ifTrue: [tiVars := model explainSpecial: string].
  					tiVars == nil
  						ifTrue: [tiVars := '']
  						ifFalse: [tiVars := tiVars , '\' withCRs].
  					"Context, Class, Pool, and Global vars, and Selectors need 
  					only test symbols"
  					(Symbol hasInterned: string ifTrue: [:s | symbol := s])
  						ifTrue: [cgVars := self explainCtxt: symbol.
  							cgVars == nil
  								ifTrue: [cgVars := self explainClass: symbol.
  									cgVars == nil ifTrue: [cgVars := self explainGlobal: symbol]].
  							"See if it is a Selector (sent here or not)"
  							selectors := self explainMySel: symbol.
  							selectors == nil
  								ifTrue: 
  									[selectors := self explainPartSel: string.
  									selectors == nil ifTrue: [
  										selectors := self explainAnySel: symbol]]]
  						ifFalse: [selectors := self explainPartSel: string].
  					cgVars == nil
  						ifTrue: [cgVars := '']
  						ifFalse: [cgVars := cgVars , '\' withCRs].
  					selectors == nil
  						ifTrue: [selectors := '']
  						ifFalse: [selectors := selectors , '\' withCRs].
  					string size = 1
  						ifTrue: ["single special characters"
  							delimitors := self explainChar: string]
  						ifFalse: ["matched delimitors"
  							delimitors := self explainDelimitor: string].
  					numbers := self explainNumber: string.
  					numbers == nil ifTrue: [numbers := ''].
  					delimitors == nil ifTrue: [delimitors := ''].
  					reply := tiVars , cgVars , selectors , delimitors , numbers].
  			reply size = 0 ifTrue: [reply := sorry].
  			self afterSelectionInsertAndSelect: reply]!

Item was changed:
  ----- Method: TextEditor>>explainGlobal: (in category 'explain') -----
  explainGlobal: symbol 
  	"Is symbol a global variable?"
  	| reply classes |
  	reply := Smalltalk at: symbol ifAbsent: [^nil].
  	(reply class == Dictionary or:[reply isKindOf: SharedPool class])
  		ifTrue: 
  			[classes := Set new.
+ 			self systemNavigation allBehaviorsDo: [:each | (each sharedPools anySatisfy: [:pool | pool == reply])
+ 				ifTrue: [classes add: each]].
- 			self systemNavigation allBehaviorsDo: [:each | (each sharedPools detect: [:pool | pool == reply]
- 					ifNone: [])
- 					~~ nil ifTrue: [classes add: each]].
  			classes := classes printString.
  			^'"is a global variable.  It is a pool which is used by the following classes ' , (classes allButFirst: 5) , '"'].
  	(reply isKindOf: Behavior)
  		ifTrue: [^'"is a global variable.  ' , symbol , ' is a class in category ', reply category,
  			'."', '\' withCRs, 'Browser newOnClass: ' , symbol , '.'].
  	symbol == #Smalltalk ifTrue: [^'"is a global.  Smalltalk is the only instance of SystemDictionary and holds all global variables."'].
  	^'"is a global variable.  ' , symbol , ' is ' , reply printString , '"'!

Item was changed:
  ----- Method: TextEditor>>explainInst: (in category 'explain') -----
  explainInst: string 
  	"Is string an instance variable of this class?"
  	| classes cls |
  
  	(model respondsTo: #selectedClassOrMetaClass) ifTrue: [
  		cls := model selectedClassOrMetaClass].
  	cls ifNil: [^ nil].	  "no class known"
  	classes := (Array with: cls)
  				, cls allSuperclasses.
+ 	classes := classes detect: [:each | each instVarNames anySatisfy: [:name | name = string]] ifNone: [^nil].
- 	classes := classes detect: [:each | (each instVarNames
- 			detect: [:name | name = string] ifNone: [])
- 			~~ nil] ifNone: [^nil].
  	classes := classes printString.
  	^ '"is an instance variable of the receiver; defined in class ' , classes , 
  		'"\' withCRs , classes , ' systemNavigation browseAllAccessesTo: ''' , string , ''' from: ', classes, '.'!

Item was changed:
  ----- Method: TextEditor>>explainMySel: (in category 'explain') -----
  explainMySel: symbol 
  	"Is symbol the selector of this method?  Is it sent by this method?  If 
  	not, then expalin will call (explainPartSel:) to see if it is a fragment of a 
  	selector sent here.  If not, explain will call (explainAnySel:) to catch any 
  	selector. "
  
  	| lits classes msg |
  	(model respondsTo: #selectedMessageName) ifFalse: [^ nil].
  	(msg := model selectedMessageName) ifNil: [^nil].	"not in a message"
  	classes := self systemNavigation allClassesImplementing: symbol.
  	classes size > 12
  		ifTrue: [classes := 'many classes']
  		ifFalse: [classes := 'these classes ' , classes printString].
  	msg = symbol
  		ifTrue: [^ '"' , symbol , ' is the selector of this very method!!  It is defined in ',
  			classes , '.  To see the other definitions, go to the message list pane, get the menu from the top of the scroll bar, and select ''implementors of...''."']
  		ifFalse: 
  			[lits := (model selectedClassOrMetaClass compiledMethodAt:
  				msg) messages.
+ 			(lits anySatisfy: [:each | each == symbol])
+ 				ifFalse: [^nil].
- 			(lits detect: [:each | each == symbol]
- 				ifNone: [])
- 				== nil ifTrue: [^nil].
  			^ '"' , symbol , ' is a message selector which is defined in ', classes , '.  To see the definitions, go to the message list pane, get the menu from the top of the scroll bar, and select ''implementors of...''."'].!

Item was changed:
  ----- Method: TextEditor>>explainPartSel: (in category 'explain') -----
  explainPartSel: string 
  	"Is this a fragment of a multiple-argument selector sent in this method?"
  	| lits whole reply classes s msg |
  
  	(model respondsTo: #selectedMessageName) ifFalse: [^ nil].
  	(msg := model selectedMessageName) ifNil: [^ nil].  "not in a message"
  	string last == $: ifFalse: [^ nil].
  	"Name of this method"
  	lits := Array with: msg.
+ 	(whole := lits detect: [:each | each keywords anySatisfy: [:frag | frag = string] ]
- 	(whole := lits detect: [:each | (each keywords detect: [:frag | frag = string]
- 					ifNone: []) ~~ nil]
  				ifNone: []) ~~ nil
  		ifTrue: [reply := ', which is the selector of this very method!!'.
  			s := '.  To see the other definitions, go to the message list pane, get the menu from the top of the scroll bar, and select ''implementors of...''."']
  		ifFalse: 
  			["Selectors called from this method"
  			lits := (model selectedClassOrMetaClass compiledMethodAt:
  				msg) messages.
  			(whole := lits detect: [:each | (each keywords detect: [:frag | frag = string]
  							ifNone: []) ~~ nil]
  						ifNone: []) ~~ nil
  				ifFalse: [string = 'primitive:'
  					ifTrue: [^self explainChar: '<']
  					ifFalse: [^nil]].
  			reply := '.'.
  			s := '.  To see the definitions, go to the message list pane, get the menu from the top of the scroll bar, and select ''implementors of...''."'].
  	classes := self systemNavigation allClassesImplementing: whole.
  	classes size > 12
  		ifTrue: [classes := 'many classes']
  		ifFalse: [classes := 'these classes ' , classes printString].
  	^ '"' , string , ' is one part of the message selector ' , whole, reply , '  It is defined in ' , classes , s!

Item was changed:
  ----- Method: WorldState>>selectHandsToDrawForDamage: (in category 'hands') -----
  selectHandsToDrawForDamage: damageList
  	"Select the set of hands that must be redrawn because either (a) the hand itself has changed or (b) the hand intersects some damage rectangle."
  
  	| result |
  	result := OrderedCollection new.
  	hands do: [:h |
  		h needsToBeDrawn ifTrue: [
  			h hasChanged
  				ifTrue: [result add: h]
  				ifFalse: [
  					| hBnds |
  					hBnds := h fullBounds.
+ 					(damageList anySatisfy: [:r | r intersects: hBnds])
+ 						ifTrue: [result add: h]]]].
- 					(damageList detect: [:r | r intersects: hBnds] ifNone: [nil])
- 						ifNotNil: [result add: h]]]].
  	^ result
  !




More information about the Squeak-dev mailing list