[squeak-dev] The Trunk: Tools-nice.351.mcz

commits at source.squeak.org commits at source.squeak.org
Sun May 8 10:35:24 UTC 2011


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

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

Name: Tools-nice.351
Author: nice
Time: 8 May 2011, 12:34:49.092 pm
UUID: 2e69b8f1-a57b-4988-ac7a-07d53acd090e
Ancestors: Tools-fbs.350

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

=============== Diff against Tools-fbs.350 ===============

Item was changed:
  ----- Method: Browser>>couldBrowseAnyClass (in category 'accessing') -----
  couldBrowseAnyClass
  	"Answer whether the receiver is equipped to browse any class. This is in support of the system-brower feature that allows the browser to be redirected at the selected class name.  This implementation is clearly ugly, but the feature it enables is handsome enough.  3/1/96 sw"
  
+ 	^self dependents
+ 		anySatisfy: [:d | (d respondsTo: #getListSelector)
+ 				and: [d getListSelector == #systemCategoryList]]!
- 	self dependents
- 		detect: [:d | (d respondsTo: #getListSelector)
- 				and: [d getListSelector == #systemCategoryList]]
- 		ifNone: [^ false].
- 	^ true!

Item was changed:
  ----- Method: Browser>>explainSpecial: (in category 'class functions') -----
  explainSpecial: string 
  	"Answer a string explaining the code pane selection if it is displaying 
  	one of the special edit functions."
  
  	| classes whole lits reply |
  	(editSelection == #editClass or: [editSelection == #newClass])
  		ifTrue: 
  			["Selector parts in class definition"
  			string last == $: ifFalse: [^nil].
  			lits := Array with:
  				#subclass:instanceVariableNames:classVariableNames:poolDictionaries:category:.
+ 			(whole := lits
+ 					detect: [:each | each keywords anySatisfy: [:frag | frag = string] ]
+ 					ifNone: []) ~~ nil
- 			(whole := lits detect: [:each | (each keywords
- 					detect: [:frag | frag = string] ifNone: []) ~~ nil]
- 						ifNone: []) ~~ nil
  				ifTrue: [reply := '"' , string , ' is one part of the message selector ' , whole , '.']
  				ifFalse: [^nil].
  			classes := self systemNavigation allClassesImplementing: whole.
  			classes := 'these classes ' , classes printString.
  			^reply , '  It is defined in ' , classes , '."
  Smalltalk browseAllImplementorsOf: #' , whole].
  
  	editSelection == #hierarchy
  		ifTrue: 
  			["Instance variables in subclasses"
  			classes := self selectedClassOrMetaClass allSubclasses.
+ 			classes := classes
+ 					detect: [:each | each instVarNames anySatisfy: [:name | name = string] ]
- 			classes := classes detect: [:each | (each instVarNames
- 						detect: [:name | name = string] ifNone: []) ~~ nil]
  					ifNone: [^nil].
  			classes := classes printString.
  			^'"is an instance variable in class ' , classes , '."
  ' , classes , ' browseAllAccessesTo: ''' , string , '''.'].
  	editSelection == #editSystemCategories ifTrue: [^nil].
  	editSelection == #editMessageCategories ifTrue: [^nil].
  	^nil!

Item was changed:
  ----- Method: CodeHolder class>>addContentsSymbolQuint:afterEntry: (in category 'controls') -----
  addContentsSymbolQuint: quint afterEntry: aSymbol 
  	"Register a menu selection item in the position after the entry with
  	selection symbol aSymbol."
  
  	"CodeHolder
  		addContentsSymbolQuint: #(#altSyntax #toggleAltSyntax #showingAltSyntaxString 'altSyntax' 'alternative syntax')
  		afterEntry: #colorPrint"
  
+ 	(ContentsSymbolQuints
+ 		anySatisfy: [:e | (e isKindOf: Collection) and: [e first = quint first]])
+ 		ifFalse: [
- 	ContentsSymbolQuints
- 		detect: [:e | (e isKindOf: Collection) and: [e first = quint first]]
- 		ifNone: [
  			| entry |
  			entry := ContentsSymbolQuints
  						detect: [:e | (e isKindOf: Collection) and: [e first = aSymbol]].
  			ContentsSymbolQuints add: quint after: entry.
  			^ self].
  	self notify: 'entry already exists for ', quint first!

Item was changed:
  ----- Method: FileList>>addPath: (in category 'private') -----
  addPath: aString
  	"Add the given string to the list of recently visited directories."
  
  	| full |
  	aString ifNil: [^self].
  	full := String streamContents: 
  		[ :strm | 2 to: volList size do: 
  			[ :i | strm nextPutAll: (volList at: i) withBlanksTrimmed.
  			strm nextPut: FileDirectory pathNameDelimiter]].
  	full := full, aString.
  "Remove and super-directories of aString from the collection."
  	RecentDirs removeAllSuchThat: [ :aDir | ((aDir, '*') match: full)].
  
  "If a sub-directory is in the list, do nothing."
+ 	(RecentDirs anySatisfy: [ :aDir | ((full, '*') match: aDir)])
+ 		ifTrue: [^self].
- 	(RecentDirs detect: [ :aDir | ((full, '*') match: aDir)] ifNone: [nil])
- 		ifNotNil: [^self].
  
  	[RecentDirs size >= 10]
  		whileTrue: [RecentDirs removeFirst].
  	RecentDirs addLast: full!

Item was changed:
  ----- Method: FileList>>isGraphicsFileSelected (in category 'private') -----
  isGraphicsFileSelected
+ 	^fileName notNil
+ 		and: [(self itemsForFile: self fullName) anySatisfy: [:each | each provider == Form and: [each selector == #importImage:]]]!
- 	^fileName notNil and: [((self itemsForFile: self fullName) detect: [:each | each provider == Form and: [each selector == #importImage:]] ifNone: []) notNil]!




More information about the Squeak-dev mailing list