Shared Smalltalk Workspace http://ws.stfx.eu/

http://ws.stfx.eu/http://ws.stfx.eu/

"Load visualization code"
Gofer new
	smalltalkhubUser: 'ObjectProfile' project: 'Roassal2';
	configuration;
	loadDevelopment.
Metacello new
	  baseline: 'VisualID';
	  repository: 'github://bergel/VisualID:master';
	  load. 

"Load methods lists from 4.0 and 5.0 (to not account for the newly added methods)"
methodsNames40 := STON fromString: (ZnEasy get: 'http://tudorgirba.com/download/pharo/methods40.ston') contents.
methodNames50 := STON fromString: (ZnEasy get: 'http://tudorgirba.com/download/pharo/methods50.ston') contents.

"Analyze methods and extract authors"
oldMethodNames := methodNames50 intersection: methodsNames40.
oldMethods := (oldMethodNames collect: [:name | [Compiler evaluate: name] on: Error do: [ nil ] ]) reject: #isNil.
oldAuthors := oldMethods collect: #author as: Set.
newMethodNames := methodNames50 \ methodsNames40.
newMethods := (newMethodNames collect: [:name | [Compiler evaluate: name] on: Error do: [ nil ] ]) reject: #isNil.
newAuthors := newMethods collect: #author as: Set.
oldMethodsWithNewCommits := Set new.
oldMethods do: [ :m |
	([ '2015-04-16T00:00:00' asDateAndTime <=
                  (DateAndTime fromMethodTimeStamp: m timeStamp) ]
                         on: Error
                         do: [ false ])
		ifTrue: [ oldMethodsWithNewCommits add: m ] ]
	displayingProgress: 'Methods'.
newAuthorsForOldMethods := oldMethodsWithNewCommits collect: #author as: Set.
allNewAuthors := newAuthors, newAuthorsForOldMethods.
allNewMethods := oldMethodsWithNewCommits, newMethods.
allMethods := ProtoObject withAllSubclasses flatCollect: [ :class | class methods ].
oldMethodsWithoutNewCommits := allMethods \ allNewMethods.

"Trim authors"
allNewMethodsByAuthor := allNewMethods groupedBy: #author.
uniqueAuthors := {
	#(tg TudorGirba) -> #TudorGirba .
	#(BaptisteQuid BaptisteQuide) -> #BaptisteQuide .
	#(ClementBEra ClementBera clementBera cb) -> #ClementBera .
	#(DenisKudriashov DenisKudryashov) -> #DenisKudriashov.
	#(HenrikNergaard HenrikNergrd Latsabben) -> #HenrikNergaard .
	#(MarcusDenker MarcusDenkr md) -> #MarcusDenker.
	#(MaxLeske Maxleske mml) -> #MaxLeske.
	#('jannik.laval' janniklaval jl) -> #JannikLaval.
	#('simon.denier' SimonDenier simondenier) -> #SimonDenier.
	#(johanfabry jf) -> #JohanFabry.
	#(YuriyTymchuk Uko) -> #YuriyTymchuk.
	#(StephaneDucasse Stef) -> #StephaneDucasse.
	#(StefanReichhart StefnReichhart) -> #StefanReichhart.
	#(Nicolaihess NicolaiHess) -> #NicolaiHess.
	#(AlexandreBergel Alexandre) -> #AlexandreBergel.
	#(DEMAREYChristophe ChristopheDemarey) -> #ChristopheDemarey.
	#(PavelKrivaenk PavelKrivanek pk) -> #PavelKrivanek.
	#(jeanbaptisteArnaud jeanbaptistearnaud jb) -> #JeanBaptisteArnaud.
	#(VincentBlondeau vincentBlondeau VincentBlondeauAbdelghaniAlidra) -> #VincentBlondeau.
	#(SvenVanCaekebenberghe SvenVanCaekenberghe) -> #SvenVanCaekenberghe .
	#(SeanDeNigris . SD) -> #SeanDeNigris .
	#(usmanbhatti) -> #UsmanBhatti .
	#(eliot eem) -> #EliotMiranda .
	#(tbn) -> #TorstenBergmann .
	#(pad) -> #PaulDeBruicker . 
	#(dkh) -> #DaleHenrichs .
	#(nice) -> #NicolasCellier .
	#(John) -> #JohnMcIntosh .
	#(lr) -> #LukasRenggli .
	#(Bite) -> #FranckWarlouzet .
	#(laza) -> #AlexanderLazarevic .
	#(das) -> #DionStewart .
	#(dtl) -> #DaveLewis .
	#(gk) -> #GoranKrampe .
	#(jcg) -> #JoshuaGargus .
	#(msb) -> #MangeshBendre .
	#(jrd) -> #JohnDougan .
	#(mir) -> #MichaelRueger . 
	#(RM) -> #ReneMeusel .
	#(spirita #Spirita) -> #MarionNoirbent .
	#(mcamp) -> #MiguelCampusano .
	#(ar) -> #AndreasRaab .
	#('') -> #Anonymous
}.
normalizedAllNewMethodsByAuthor := Dictionary new.
allNewMethodsByAuthor associations do: [ :assoc |
	| name |
	name := uniqueAuthors 
		detect: [ :names | names key includes: assoc key ]
		ifFound: [ :names | names value ]
		ifNone: [ assoc key ].
	
	(normalizedAllNewMethodsByAuthor at: name capitalized asSymbol ifAbsentPut: [ OrderedCollection new ])
		addAll: assoc value ].
nonAuthors := #(synectique '' Fuel foo TravisCI TheIntegrator Anonymous AutoGenTutorial SpurBootstrap auto).
humanAuthors := normalizedAllNewMethodsByAuthor keys reject: [ :each | nonAuthors includes: each ].

"Visualization: Authors - Classes - Packages - VisualIDs"
touchedMethods := (humanAuthors flatCollectAsSet: [:each | normalizedAllNewMethodsByAuthor at: each]).
touchedClasses := touchedMethods collect: [:each | each methodClass ] as: Set.
touchedPackages := touchedClasses collect: [:each | each package] as: Set.
touchedPackagePrefixes := ((touchedClasses collect: [ :each | each package name ] as: Set) select: [ :each | each includesSubstring: '-' ]) collect: [:each | each copyUpTo: $- ] as: Set.
view := RTMondrian new.
view shape circle color: (Color veryLightGray alpha: 0.5); size: 1.
view nodes: touchedClasses.
view shape circle color: (Color veryLightGray alpha: 0.5); size: 10.
view nodes: touchedPackages.
view shape circle color: (Color veryLightGray alpha: 0.5); size: 15.
view nodes: touchedPackagePrefixes.
view shape shape: (RTVisualID new basedOn: [ :each | (normalizedAllNewMethodsByAuthor at: each) collect: [ :m | m methodClass package name copyUpTo: $- ] as: Set ]); color: (Color red alpha: 0.8); shadowColor: (Color white alpha: 0.5); size: 200.
view nodes: humanAuthors.
view shape line color: (Color veryLightGray alpha: 0.1).
view edges 
	source: touchedPackages 
	connectFrom: [ :each | each package name copyUpTo: $- ] 
	to: #yourself.
view shape line color: (Color veryLightGray alpha: 0.1).
view edges source: touchedClasses connectFrom: #package to: #yourself.
view shape line color: ((Color r: 1.0 g: 0.7 b: 0.7) alpha: 0.4); width: 1.
view edges source: humanAuthors connectFrom: #yourself toAll: [ :each | (normalizedAllNewMethodsByAuthor at: each) collect: [ :m | m methodClass ] as: Set ].
view layout force charge: -100.
view view pushBackEdges.
view.