The Trunk: ShoutCore-ul.48.mcz

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!