[Pkg] The Trunk: ShoutCore-ul.48.mcz

commits at source.squeak.org commits at source.squeak.org
Sat May 2 11:53:22 UTC 2015 

Levente Uzonyi uploaded a new version of ShoutCore to project The Trunk:
http://source.squeak.org/trunk/ShoutCore-ul.48.mcz

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

Name: ShoutCore-ul.48
Author: ul
Time: 2 May 2015, 1:52:29.292 pm
UUID: 5ad6f857-2c78-4d6d-8dce-ce8ff7d837c5
Ancestors: ShoutCore-ul.47

SHMCClassDefinition changes:
- Implemented the missing #withAllSuperclassesDo:
- #withAllSuperclasses uses #withAllSuperclassesDo:, and returns an OrderedCollection with the classes in the same order as in Behavior's implementation.
- Recategorized some methods.

Use #withAllSuperclassesDo: instead of #withAllSuperclasses in all methods of SHParserST80.

Updated TextAction >> #shoutShouldPreserve to reflect the original intention - preserve all TextAction attributes.

Slightly faster SHTextStylerST80 >> #setAttributesIn:fromRanges:.

Removed the now useless SHTextStylerST80 >> #shouldPreserveAttribute:.

=============== Diff against ShoutCore-ul.47 ===============

Item was changed:
+ ----- Method: SHMCClassDefinition>>allInstVarNames (in category 'act like a class') -----
- ----- Method: SHMCClassDefinition>>allInstVarNames (in category 'accessing') -----
  allInstVarNames
  	| superclassOrDef answer classOrDef instVars|
  	
  	answer := meta
  		ifTrue:[classDefinition classInstVarNames asArray]
  		ifFalse:[	classDefinition instVarNames asArray].
  	classOrDef := classDefinition.
  	[superclassOrDef := (classOrDef isKindOf: MCClassDefinition)
  		ifTrue:[ |s|
  			s := classOrDef superclassName.
  			items 
  				detect: [:ea | ea isClassDefinition and: [ea className = s]]
  				ifNone: [Smalltalk at: s asSymbol ifAbsent:[nil]]]
  		ifFalse:[ | sc |
  			sc := classOrDef superclass.
  			sc ifNotNil:[
  				items 
  					detect: [:ea | ea isClassDefinition and: [ea className = sc name asString]]
  					ifNone: [sc]	]].
  	superclassOrDef isNil
  	] whileFalse:[
  		instVars := (superclassOrDef isKindOf: MCClassDefinition)
  			ifTrue:[
  				meta 
  					ifTrue:[superclassOrDef classInstVarNames]
  					ifFalse:[superclassOrDef instVarNames]]
  			ifFalse:["real"
  				meta
  					ifTrue:[superclassOrDef theNonMetaClass class  instVarNames]
  					ifFalse:[superclassOrDef theNonMetaClass instVarNames]].		
  		answer := answer, instVars.
  		classOrDef := superclassOrDef].
  	^answer!

Item was changed:
+ ----- Method: SHMCClassDefinition>>shoutParserClass (in category 'act like a class') -----
- ----- Method: SHMCClassDefinition>>shoutParserClass (in category 'accessing') -----
  shoutParserClass
  	"Answer the parser class"
  	^SHParserST80!

Item was changed:
+ ----- Method: SHMCClassDefinition>>withAllSuperclasses (in category 'act like a class') -----
- ----- Method: SHMCClassDefinition>>withAllSuperclasses (in category 'accessing') -----
  withAllSuperclasses
+ 
+ 	| result |
+ 	result := OrderedCollection new.
+ 	self withAllSuperclassesDo: [ :each | result addFirst: each ].
+ 	^result!
- 	| superclassOrDef answer classOrDef |
- 	
- 	answer := Array with: self.
- 	classOrDef := classDefinition.
- 	[superclassOrDef := (classOrDef isKindOf: MCClassDefinition)
- 		ifTrue:[ |s|
- 			s := classOrDef superclassName.
- 			items 
- 				detect: [:ea | ea isClassDefinition and: [ea className = s]]
- 				ifNone: [Smalltalk at: s asSymbol ifAbsent:[nil]]]
- 		ifFalse:[ | sc |
- 			sc := classOrDef superclass.
- 			sc ifNotNil:[
- 				items 
- 					detect: [:ea | ea isClassDefinition and: [ea className = sc name asString]]
- 					ifNone: [sc]	]].
- 	superclassOrDef isNil
- 	] whileFalse:[
- 		answer := answer, (Array with: superclassOrDef).
- 		classOrDef := superclassOrDef].
- 	^answer!

Item was added:
+ ----- Method: SHMCClassDefinition>>withAllSuperclassesDo: (in category 'act like a class') -----
+ withAllSuperclassesDo: aBlock
+ 
+ 	| superclassOrDef classOrDef |
+ 	aBlock value: self.
+ 	classOrDef := classDefinition.
+ 	[ 
+ 		superclassOrDef := (classOrDef isKindOf: MCClassDefinition)
+ 			ifTrue: [
+ 				| superclassName |
+ 				superclassName := classOrDef superclassName.
+ 				items 
+ 					detect: [ :each | 
+ 						each isClassDefinition and: [
+ 							each className = superclassName ] ]
+ 					ifNone: [ Smalltalk classNamed: superclassName ] ]
+ 			ifFalse: [ 
+ 				classOrDef superclass ifNotNil: [ :superclass |
+ 					| superclassName |
+ 					superclassName := superclass name asString.
+ 					items 
+ 						detect: [ :each | 
+ 							each isClassDefinition and: [
+ 								each className = superclassName ] ]
+ 						ifNone: [ superclass ] ] ].
+ 		superclassOrDef isNil ] 
+ 		whileFalse: [
+ 			aBlock value: superclassOrDef.
+ 			classOrDef := superclassOrDef ]!

Item was changed:
  ----- Method: SHParserST80>>resolvePartial: (in category 'identifier testing') -----
  resolvePartial: aString 
  	"check if any identifier begins with aString"
  	
  	(#('self' 'super' 'true' 'false' 'nil' 'thisContext') anySatisfy: [:each | each beginsWith: aString]) 
  		ifTrue: [^#incompleteIdentifier].
  	(self isIncompleteBlockTempName: aString) ifTrue: [^#incompleteIdentifier].
  	(self isIncompleteBlockArgName: aString) ifTrue: [^#incompleteIdentifier].
  	(self isIncompleteMethodTempName: aString) ifTrue: [^#incompleteIdentifier].
  	(self isIncompleteMethodArgName: aString) ifTrue: [^#incompleteIdentifier].
  	(instanceVariables anySatisfy: [:each | each beginsWith: aString]) ifTrue: [^#incompleteIdentifier].
  	workspace 
  		ifNotNil: [(workspace hasBindingThatBeginsWith: aString) ifTrue: [^#incompleteIdentifier]].
  	classOrMetaClass
  		ifNotNil: [
+ 			classOrMetaClass theNonMetaClass withAllSuperclassesDo: [:c | 
- 			classOrMetaClass theNonMetaClass withAllSuperclasses do: [:c | 
  				(c classPool hasBindingThatBeginsWith: aString) ifTrue: [^#incompleteIdentifier].
  				c sharedPools do: [:p | (p hasBindingThatBeginsWith: aString) ifTrue: [^#incompleteIdentifier]].
  				(c environment hasBindingThatBeginsWith: aString) ifTrue: [^#incompleteIdentifier]]]
  		ifNil: [(environment hasBindingThatBeginsWith: aString) ifTrue: [^#incompleteIdentifier]].
  	^#undefinedIdentifier!

Item was changed:
  ----- Method: SHParserST80>>resolvePartialPragmaArgument: (in category 'identifier testing') -----
  resolvePartialPragmaArgument: aString 
  	"check if any valid pragma argument begins with aString"
  	
  	(#('true' 'false' 'nil') anySatisfy: [:each | each beginsWith: aString]) 
  		ifTrue: [^#incompleteIdentifier].
  	"should really check that a matching binding is for a Class?"
  	classOrMetaClass
  		ifNotNil: [
+ 			classOrMetaClass theNonMetaClass withAllSuperclassesDo: [:c | 
- 			classOrMetaClass theNonMetaClass withAllSuperclasses do: [:c | 
  				(c environment hasBindingThatBeginsWith: aString) ifTrue: [^#incompleteIdentifier]]]
  		ifNil: [(environment hasBindingThatBeginsWith: aString) ifTrue: [^#incompleteIdentifier]].
  	^#undefinedIdentifier!

Item was changed:
  ----- Method: SHParserST80>>resolvePragmaArgument: (in category 'identifier testing') -----
  resolvePragmaArgument: aString 
  	(#('true' 'false' 'nil') includes: aString) ifTrue: [^aString asSymbol].
  	"should really check that global is a class?"
  	(Symbol lookup: aString) ifNotNil: [:sym | 
  		classOrMetaClass 
  			ifNotNil: [
+ 				classOrMetaClass theNonMetaClass withAllSuperclassesDo: [:c | 
- 				classOrMetaClass theNonMetaClass withAllSuperclasses do: [:c | 
  					(c environment bindingOf: sym) ifNotNil: [^#globalVar]]]
  			ifNil: [(environment bindingOf: sym) ifNotNil: [^#globalVar]]].
  	^self resolvePartialPragmaArgument: aString!

Item was changed:
  ----- Method: SHTextStylerST80>>setAttributesIn:fromRanges: (in category 'private') -----
  setAttributesIn: aText fromRanges: ranges
  	| charAttr defaultAttr attr newRuns newValues lastAttr oldRuns lastCount | 		
  		
  	oldRuns := aText runs.
  	defaultAttr := self attributesFor: #default.
+ 	charAttr := Array new: aText size withAll: defaultAttr.
+ 	ranges do: [ :range |
+ 		(self attributesFor: range type) ifNotNil: [ :attribute |
+ 			charAttr from: range start to: range end put: attribute ] ].
+ 	newRuns := OrderedCollection new: ranges size * 2 + 1.
+ 	newValues := OrderedCollection new: ranges size * 2 + 1.
+ 	lastAttr := nil.
+ 	lastCount := 0.
+ 	1 to: charAttr size do: [ :i |
+ 		(attr := charAttr at: i) == lastAttr
- 	charAttr := Array new: aText size.
- 	1 to: charAttr size do: [:i | charAttr at: i put: defaultAttr].
- 	ranges do: [:range |
- 		(attr := self attributesFor: range type) == nil
- 			ifFalse:[	range start to: range end do: [:i | charAttr at: i put: attr]]].
- 	newRuns := OrderedCollection new: charAttr size // 10.
- 	newValues := OrderedCollection new: charAttr size // 10.
- 	1 to: charAttr size do: [:i |
- 		attr := charAttr at: i.
- 		i = 1 
  			ifTrue: [
+ 				lastCount := lastCount + 1.
+ 				newRuns at: newRuns size put: lastCount ]
+ 			ifFalse: [
+ 				newRuns addLast: 1.
- 				newRuns add: 1.
  				lastCount := 1.
+ 				lastAttr := newValues addLast: attr ] ].
- 				lastAttr := newValues add: attr]
- 			ifFalse:[
- 				attr == lastAttr
- 					ifTrue: [
- 						lastCount := lastCount + 1.
- 						newRuns at: newRuns size put: lastCount]
- 					ifFalse: [
- 						newRuns add: 1.
- 						lastCount := 1.
- 						lastAttr := newValues add: attr]]].	
  	aText runs: (RunArray runs: newRuns values: newValues).
  	oldRuns withStartStopAndValueDo:[:start :stop :attribs|
+ 		(attribs anySatisfy: [ :each | each shoutShouldPreserve ]) ifTrue: [
+ 			attribs do: [ :each | aText addAttribute: each from: start to: stop ] ] ].
- 		(attribs anySatisfy: [:each | self shouldPreserveAttribute: each])
- 			ifTrue: [
- 				attribs do: [:eachAttrib | aText addAttribute: eachAttrib from: start to: stop]]].
  	!

Item was removed:
- ----- Method: SHTextStylerST80>>shouldPreserveAttribute: (in category 'private') -----
- shouldPreserveAttribute: aTextAttribute
- 	"Answer true if Shout should preserve ALL the attributes in the same run as the argument,
- 	false otherwise"
- 	^aTextAttribute shoutShouldPreserve!

Item was changed:
  ----- Method: TextAction>>shoutShouldPreserve (in category '*ShoutCore') -----
  shoutShouldPreserve
  
+ 	^true!
- 	^self class == TextAction!

More information about the Packages mailing list