[Pkg] Squeak3.11 Contributions: MethodAuthorship-mtf.9.mcz

squeak-dev-noreply at lists.squeakfoundation.org squeak-dev-noreply at lists.squeakfoundation.org
Sat Feb 7 18:01:15 UTC 2009


A new version of Methodauthorship was added to project Squeak3.11 Contributions:
http://www.squeaksource.com/311/MethodAuthorship-mtf.9.mcz

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

Name: MethodAuthorship-mtf.9
Author: mtf
Time: 7 February 2009, 1:01:11 pm
UUID: 4e71e981-4485-4f0f-921d-720c20ae61f8
Ancestors: MethodAuthorship-yo.8

saved a version with corrected class category names

==================== Snapshot ====================

SystemOrganization addCategory: #MethodAuthorship!

ChangeRecord subclass: #MethodHistoryChangeRecord
	instanceVariableNames: 'text selector sourceFile'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'MethodAuthorship'!

----- Method: MethodHistoryChangeRecord>>author (in category 'all') -----
author

	^ (stamp copyUpTo: $ ) copyWithout: Character lf.
!

----- Method: MethodHistoryChangeRecord>>class:selector:stamp:text:sourceFile: (in category 'all') -----
class: clsName selector: sel stamp: st text: t sourceFile: fileName

	class _ clsName copyUpTo: $ .	"the non-meta part of a class name"
	meta _ clsName endsWith: ' class'.
	selector := sel.
	stamp := st.
	text := t.
	type := #method.
	sourceFile := fileName.
!

----- Method: MethodHistoryChangeRecord>>equals: (in category 'all') -----
equals: another

	"^ self methodClassName = another methodClassName and: [
		self methodSelector = another methodSelector and: [
			self text = another text and: [self stamp = another stamp]]].
"
	^ self text = another text and: [self stamp = another stamp]!

----- Method: MethodHistoryChangeRecord>>fileName (in category 'all') -----
fileName

	^ sourceFile ifNil: ['unknown'].
!

----- Method: MethodHistoryChangeRecord>>methodClass (in category 'all') -----
methodClass

	^ class, (meta ifTrue: [' class'] ifFalse: ['']).
!

----- Method: MethodHistoryChangeRecord>>methodSelector (in category 'all') -----
methodSelector

	^ selector!

----- Method: MethodHistoryChangeRecord>>shortPrintOn: (in category 'all') -----
shortPrintOn: aStream
	"Print the receiver on a stream"

	aStream nextPutAll: ' ', self methodClass name, ' >> ', self methodSelector, ' (', self stamp, ')'!

----- Method: MethodHistoryChangeRecord>>string (in category 'all') -----
string

	^ text
!

----- Method: MethodHistoryChangeRecord>>text (in category 'all') -----
text

	^ text ifNil: [text := super text].
!

----- Method: Browser>>openHistoryEditing: (in category '*methodauthorship') -----
openHistoryEditing: editString
	"Create a pluggable version of all the views for a Browser, including views and controllers."
	| window hSepFrac switchHeight mySingletonList nextOffsets |

	window _ (SystemWindow labelled: 'later') model: self.
	hSepFrac _ 0.30.
	switchHeight _ 25.
	mySingletonList _ PluggableListMorph on: self list: #historySingleton
			selected: #indexIsOne changeSelected: #indexIsOne:
			menu: #systemCatSingletonMenu: keystroke: #systemCatSingletonKey:from:.
 	mySingletonList enableDragNDrop: Preferences browseWithDragNDrop.
	mySingletonList hideScrollBarsIndefinitely.
	window 
		addMorph: mySingletonList
		fullFrame: (
			LayoutFrame 
				fractions: (0 at 0 corner: 1 at 0) 
				offsets: (0 at 0  corner: 0 at switchHeight)
		).	

	self 
		addClassAndSwitchesTo: window 
		at: (0 at 0 corner: 0.5 at hSepFrac)
		plus: switchHeight.

	nextOffsets _ 0 at switchHeight corner: 0 at 0.

	window 
		addMorph: self buildMorphicMessageList
		fullFrame: (
			LayoutFrame 
				fractions: (0.5 at 0 corner: 1 at hSepFrac) 
				offsets: nextOffsets
		).	

	self 
		addLowerPanesTo: window 
		at: (0 at hSepFrac corner: 1 at 1) 
		with: editString.

	window setUpdatablePanesFrom: #( classList messageCategoryList messageList).
	^ window!

----- Method: Browser>>openHistoryString: (in category '*methodauthorship') -----
openHistoryString: aString
	"Create a pluggable version of all the views for a Browser, including views and controllers.  The top list view is of the currently selected system class category--a single item list."
	| systemCategoryListView classListView messageCategoryListView messageListView browserCodeView topView switchView y annotationPane underPane optionalButtonsView |

	Smalltalk isMorphic ifTrue: [^ self openHistoryEditing: aString].

	topView _ (StandardSystemView new) model: self.
	topView borderWidth: 1.
		"label and minSize taken care of by caller"

	systemCategoryListView _ PluggableListView on: self
		list: #systemCategorySingleton
		selected: #indexIsOne 
		changeSelected: #indexIsOne:
		menu: #systemCatSingletonMenu:
		keystroke: #systemCatSingletonKey:from:.
	systemCategoryListView window: (0 @ 0 extent: 200 @ 12).
	topView addSubView: systemCategoryListView.

	classListView _ PluggableListView on: self
		list: #classList
		selected: #classListIndex
		changeSelected: #classListIndex:
		menu: #classListMenu:shifted:
		keystroke: #classListKey:from:.
	classListView window: (0 @ 0 extent: 67 @ 62).
	topView addSubView: classListView below: systemCategoryListView.

	messageCategoryListView _ PluggableListView on: self
		list: #messageCategoryList
		selected: #messageCategoryListIndex
		changeSelected: #messageCategoryListIndex:
		menu: #messageCategoryMenu:.
	messageCategoryListView controller terminateDuringSelect: true.
	messageCategoryListView window: (0 @ 0 extent: 66 @ 70).
	topView addSubView: messageCategoryListView toRightOf: classListView.

	switchView _ self buildInstanceClassSwitchView.
	switchView 
		window: switchView window 
		viewport: (classListView viewport bottomLeft 
					corner: messageCategoryListView viewport bottomLeft).
	switchView borderWidth: 1.
	topView addSubView: switchView below: classListView.

	messageListView _ PluggableListView on: self
		list: #messageList
		selected: #messageListIndex
		changeSelected: #messageListIndex:
		menu: #messageListMenu:shifted:
		keystroke: #messageListKey:from:.
	messageListView menuTitleSelector: #messageListSelectorTitle.
	messageListView window: (0 @ 0 extent: 67 @ 70).
	topView addSubView: messageListView toRightOf: messageCategoryListView.

	 self wantsAnnotationPane
		ifTrue:
			[annotationPane _ PluggableTextView on: self
				text: #annotation accept: nil
				readSelection: nil menu: nil.
			annotationPane window: (0 at 0 extent: 200 at self optionalAnnotationHeight).
			topView addSubView: annotationPane below: switchView.
			y _ 110 - 12 - self optionalAnnotationHeight.
			underPane _ annotationPane]
		ifFalse:
			[y _ 110 - 12.
			underPane _ switchView].

	self wantsOptionalButtons ifTrue:
		[optionalButtonsView _ self buildOptionalButtonsView.
		optionalButtonsView borderWidth: 1.
		topView addSubView: optionalButtonsView below: underPane.
		underPane _ optionalButtonsView.
		y _ y - self optionalButtonHeight].

	browserCodeView _ MvcTextEditor default on: self 
			text: #contents accept: #contents:notifying:
			readSelection: #contentsSelection menu: #codePaneMenu:shifted:.
	browserCodeView window: (0 at 0 extent: 200 at y).
	topView addSubView: browserCodeView below: underPane.
	aString ifNotNil: [browserCodeView editString: aString.
			browserCodeView hasUnacceptedEdits: true].
	topView setUpdatablePanesFrom: #(classList messageCategoryList messageList).
	^ topView!

Browser subclass: #MethodHistoryBrowser
	instanceVariableNames: 'database'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'MethodAuthorship'!

----- Method: MethodHistoryBrowser class>>example1 (in category 'as yet unclassified') -----
example1

	| m sV1 c11 c113 c117 c118 c119 c12 c122 c123 c131 sV2 c20 c21 c22 c23 c24 c25 c26 c27 c28 sV3 c30 c31 c32 c34 c35 c36 c37 c38 sq e23 ev3 e3l b |
	m := MethodHistoryDatabase new.
	sV1 := m processChangesFile: 'SqueakV1.sources' encoding: 'mac-roman'.
	c11 := m processChangesFile: 'Squeak1.1.changes' encoding: 'mac-roman'.
	c113 := m processChangesFile: 'Squeak1.13u.changes' encoding: 'mac-roman'.
	"1.16 is proper prefix of 1.17."
	c117 := m processChangesFile: 'Squeak1.17u.changes' encoding: 'mac-roman'.
	c118 := m processChangesFile: 'Squeak1.18.changes' encoding: 'mac-roman'.
	c119 := m processChangesFile: 'Squeak1.19d.changes' encoding: 'mac-roman'.
	c12 := m processChangesFile: 'Squeak1.2.changes' encoding: 'mac-roman'.
	c122 := m processChangesFile: 'Squeak1.22.changes' encoding: 'mac-roman'.
	c123 := m processChangesFile: 'Squeak1.23up.changes' encoding: 'mac-roman'.
	c131 := m processChangesFile: 'Squeak1.31.changes' encoding: 'mac-roman'.
	sV2 := m processChangesFile: 'SqueakV2.sources' encoding: 'mac-roman'.
	c20 := m processChangesFile: 'Squeak2.0.changes' encoding: 'mac-roman'.
	c21 := m processChangesFile: 'Squeak2.1.changes' encoding: 'mac-roman'.
	c22 := m processChangesFile: 'Squeak2.2.changes' encoding: 'mac-roman'.
	c23 := m processChangesFile: 'Squeak2.3.changes' encoding: 'mac-roman'.
	c24 := m processChangesFile: 'Squeak2.4b.changes' encoding: 'mac-roman'.
	c25 := m processChangesFile: 'Squeak2.5.changes' encoding: 'mac-roman'.
	c26 := m processChangesFile: 'Squeak2.6.changes' encoding: 'mac-roman'.
	c27 := m processChangesFile: 'Squeak2.7.changes' encoding: 'mac-roman'.
	c28 := m processChangesFile: 'Squeak2.8.changes' encoding: 'mac-roman'.
	sV3 := m processChangesFile: 'SqueakV3.sources' encoding: 'mac-roman'.
	c30 := m processChangesFile: 'Squeak3.0.changes' encoding: 'mac-roman'.
	c31 := m processChangesFile: 'Squeak3.1beta-4411.changes' encoding: 'mac-roman'.
	c32 := m processChangesFile: 'Squeak3.2-4956.changes' encoding: 'mac-roman'.
	c34 := m processChangesFile: 'Squeak3.4.changes' encoding: 'mac-roman'.
	c35 := m processChangesFile: 'Squeak3.5-5180.changes' encoding: 'mac-roman'.
	c36 := m processChangesFile: 'Squeak3.6-5429-full.changes' encoding: 'mac-roman'.
	c37 := m processChangesFile: 'Squeak3.7-5989-full.changes' encoding: 'mac-roman'.
	c38 := m processChangesFile: 'Squeak3.8-6665full.changes' encoding: 'utf-8'.
	sq := m processChangesFile: 'SqueakPlugin-dev.changes' encoding: 'utf-8'.
	e23 := m processChangesFile: 'etoys-dev-2.3-2.changes' encoding: 'utf-8'.
	ev3 := m processChangesFile: 'EtoysV3.sources' encoding: 'utf-8'.
	e3l := m processChangesFile: 'etoys-dev-3.0-2-2079.changes' encoding: 'utf-8'.

	m processChangesList: sV1.
	m processChangesList: c11.
	m processChangesList: c113.
	m processChangesList: c117.
	m processChangesList: c118.
	m processChangesList: c119.
	m processChangesList: c12.
	m processChangesList: c122.
	m processChangesList: c123.
	m processChangesList: c131.
	m processChangesList: sV2.
	m processChangesList: c20.
	m processChangesList: c21.
	m processChangesList: c22.
	m processChangesList: c23.
	m processChangesList: c24.
	m processChangesList: c25.
	m processChangesList: c26.
	m processChangesList: c27.
	m processChangesList: c28.
	m processChangesList: sV3.
	m processChangesList: c30.
	m processChangesList: c31.
	m processChangesList: c32.
	m processChangesList: c34.
	m processChangesList: c35.
	m processChangesList: c36.
	m processChangesList: c37.
	m processChangesList: c38.

	m processChangesList: sq.
	m processChangesList: e23.
	m processChangesList: ev3.
	m processChangesList: e3l.

	b := MethodHistoryBrowser new.
	b database: m.
	MethodHistoryBrowser openBrowserView: (b openEditString: nil) label: 'foo'.!

----- Method: MethodHistoryBrowser class>>example2 (in category 'as yet unclassified') -----
example2

	| m d b |
	MethodHistoryChangeList ignoreNonExsiting: true.
	m := MethodHistoryDatabase new.

	m readFile: 'SqueakV1.sources' encodingName: 'mac-roman'.
	d := FileDirectory default directoryNamed: 'history-updates'.
	#('PreBeta' 'Sqk20Beta') do: [:v |
		m readFilesIn: d updateFile: 'updates.list' versionName: v.].

	m readFile: 'SqueakV2.sources' encodingName: 'mac-roman'.
	#('Squeak2.0' 'Squeak2.1' 'Squeak2.2beta' 'Squeak2.2' 'Squeak2.3' 'Squeak2.4' 'Squeak2.5test' 'Squeak2.5' 'Squeak2.6alpha' 'Squeak2.6' 'Squeak2.7alpha' 'Squeak2.7' 'Squeak2.8alpha' 'Squeak2.8' 'Squeak2.9alpha') do: [:v |
		m readFilesIn: d updateFile: 'updates.list' versionName: v.].

	m readFile: 'SqueakV3.sources' encodingName: 'mac-roman'.
	#('Squeak3.0' 'Squeak3.1alpha' 'Squeak3.1beta' 'Squeak3.2alpha' 'Squeak3.2gamma' 'Squeak3.2' 'Squeak3.2.1' 'Squeak3.4alpha' 'Squeak3.4beta' 'Squeak3.4gamma' 'Squeak3.5alpha' 'Squeak3.5beta' 'Squeak3.5gamma' 'Squeak3.6alpha' 'Squeak3.6beta' 'Squeak3.6gamma' 'Squeak3.6') do: [:v |
		m readFilesIn: d updateFile: 'updates.list' versionName: v.].

	d := FileDirectory default directoryNamed: 'squeak.org-updates'.
	#('Squeak3.7alpha' 'Squeak3.7beta' 'Squeak3.7gamma' 'Squeak3.7' 'Squeak3.8alpha' 'Squeak3.8beta' 'Squeak3.8gamma') do: [:v |
		m readFilesIn: d updateFile: 'SqCupdates.list' versionName: v.].

	d := FileDirectory default directoryNamed: 'squeakland.org-updates'.
	#('Squeakland 3.1.3905' 'Squeakland 3.1.4295' 'Squeakland 3.2.4913' 'Squeakland 3.8.5976' 'Squeakland05' 'Squeakland 3.8-05') do: [:v |
		m readFilesIn: d updateFile: 'updates.list' versionName: v.].

	d := FileDirectory default directoryNamed: 'olpc-updates'.
	#('OLPC1.0' 'OLPC2.0') do: [:v |
		m readFilesIn: d updateFile: 'updates.list' versionName: v.].

	d := FileDirectory default directoryNamed: 'etoys-updates'.
	#('etoys2.1' 'etoys2.2' 'etoys2.3') do: [:v |
		m readFilesIn: d updateFile: 'updates.list' versionName: v.].

	m readFile: 'EtoysV3.sources' encodingName: 'utf-8'.
	#('etoys3.0') do: [:v |
		m readFilesIn: d updateFile: 'updates.list' versionName: v.].

	b := MethodHistoryBrowser new.
	b database: m.
	MethodHistoryBrowser openBrowserView: (b openEditString: nil) label: 'foo'.!

----- Method: MethodHistoryBrowser>>annotation (in category 'all') -----
annotation

	^ ''.
!

----- Method: MethodHistoryBrowser>>browseVersions (in category 'all') -----
browseVersions
	"Create and schedule a Versions Browser, showing all versions of the 
	currently selected message. Answer the browser or nil."
	| selector class | 
	self classCommentIndicated
		ifTrue: [ ClassCommentVersionsBrowser browseCommentOf: self selectedClass.
			^nil ].

	(selector _ self selectedMessageName)
		ifNil:[ self inform: 'Sorry, only actual methods have retrievable versions.'. ^nil ]
		ifNotNil: [
			class _ self selectedClassOrMetaClass.
			^MethodHistoryVersionBrowser
				browseVersionsOf: nil
				class: self selectedClass
				meta: class isMeta
				category: (class organization categoryOfElement: selector)
				selector: selector
				database: database]!

----- Method: MethodHistoryBrowser>>classList (in category 'all') -----
classList

	^ ((database keys reject: [:e | e endsWith: ' class']) asSortedCollection: [:a :b | a < b])!

----- Method: MethodHistoryBrowser>>database: (in category 'all') -----
database: d

	database := d.
!

----- Method: MethodHistoryBrowser>>historySingleton (in category 'all') -----
historySingleton

	^ Array with: 'Historical all classes'!

----- Method: MethodHistoryBrowser>>messageList (in category 'all') -----
messageList
	"Answer an Array of the message selectors of the currently selected message category, provided that the messageCategoryListIndex is in proper range.  Otherwise, answer an empty Array  If messageCategoryListIndex is found to be larger than the number of categories (it happens!!), it is reset to zero."
	| class |
	class := self selectedClass.
	^ (database at: class name ) keys asSortedCollection
!

----- Method: MethodHistoryBrowser>>selectedClass (in category 'all') -----
selectedClass
	"Answer the class that is currently selected. Answer nil if no selection 
	exists."

	| name pseudoClass |
	(name _ self selectedClassName) ifNil: [^ nil].
	pseudoClass := PseudoClass new.
	pseudoClass name: name.
	^pseudoClass.!

----- Method: MethodHistoryBrowser>>selectedMessage (in category 'all') -----
selectedMessage
	"Answer a copy of the source code for the selected message."

	| class selector |
	contents == nil ifFalse: [^ contents copy].

	self showingDecompile ifTrue:
		[^ self decompiledSourceIntoContentsWithTempNames: Sensor leftShiftDown not ].

	class _ self selectedClassOrMetaClass.
	selector _ self selectedMessageName.
	^ (database sourceCodeAt: class name asSymbol at: selector).
!

OrderedCollection subclass: #MethodCollection
	instanceVariableNames: 'title'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'MethodAuthorship'!

----- Method: MethodCollection class>>titled: (in category 'as yet unclassified') -----
titled: aName
	^self new title: aName!

----- Method: MethodCollection>>printOn: (in category 'accessing') -----
printOn: aStream 
	aStream nextPutAll: 'methods by ';
		 nextPutAll: title;
		 cr.
	self do: [:each | aStream tab. each shortPrintOn: aStream. aStream cr]!

----- Method: MethodCollection>>title (in category 'accessing') -----
title
	^ title!

----- Method: MethodCollection>>title: (in category 'accessing') -----
title: aName 
	title := aName!

----- Method: PseudoClass>>definitionST80: (in category '*methodauthorship') -----
definitionST80: aBoolean

	^ ''.
!

ChangeList subclass: #MethodHistoryChangeList
	instanceVariableNames: ''
	classVariableNames: 'IgnoreNonExsiting'
	poolDictionaries: ''
	category: 'MethodAuthorship'!

----- Method: MethodHistoryChangeList class>>ignoreNonExsiting: (in category 'as yet unclassified') -----
ignoreNonExsiting: aBoolean

	IgnoreNonExsiting _ aBoolean.
!

----- Method: MethodHistoryChangeList>>annotation (in category 'all') -----
annotation

	^ '------'
!

----- Method: MethodHistoryChangeList>>contentsDiffedFromCurrent (in category 'all') -----
contentsDiffedFromCurrent
	"Answer the contents diffed forward from current (in-memory) method version"

	| aChange aClass |
	listIndex = 0
		ifTrue: [^ ''].
	aChange _ changeList at: listIndex.
	^ (aChange type == #method and: [(aClass _ aChange methodClass) notNil])
		ifTrue:
			 [(changeList size >= (listIndex + 1)) ifTrue: [
				 TextDiffBuilder
					buildDisplayPatchFrom: (changeList at: listIndex + 1) text
					to: aChange text
					inClass: aClass
					prettyDiffs: self showingPrettyDiffs] ifFalse: [(changeList at: listIndex) text]]
		ifFalse:
			[(changeList at: listIndex) text]!

----- Method: MethodHistoryChangeList>>ignoreNonExisting (in category 'all') -----
ignoreNonExisting

	^ IgnoreNonExsiting ifNil: [^ true].
!

----- Method: MethodHistoryChangeList>>initializeForDatabase (in category 'all') -----
initializeForDatabase

	listSelections := Array new: list size withAll: false.
!

----- Method: MethodHistoryChangeList>>scanCategory (in category 'all') -----
scanCategory  
	"Scan anything that involves more than one chunk; method name is historical only"

	| item tokens stamp isComment anIndex |
	item _ file nextChunk.

	isComment _ (item includesSubString: 'commentStamp:').
	(isComment or: [item includesSubString: 'methodsFor:']) ifFalse:
		[^ self].

	tokens _ Scanner new scanTokens: item.
	tokens size >= 3 ifTrue:
		[stamp _ ''.
		anIndex _ tokens indexOf: #stamp: ifAbsent: [nil].
		anIndex ifNotNil: [stamp _ tokens at: (anIndex + 1)].

		tokens second == #methodsFor:
			ifTrue: [^ self scanCategory: tokens third class: tokens first
							meta: false stamp: stamp].
		tokens third == #methodsFor:
			ifTrue: [^ self scanCategory: tokens fourth class: tokens first
							meta: true stamp: stamp]].

		tokens second == #commentStamp:
			ifTrue:
				[stamp _ tokens third.
				"self addItem:
						(ChangeRecord new file: file position: file position type: #classComment
										class: tokens first category: nil meta: false stamp: stamp)
						text: 'class comment for ' , tokens first, 
							  (stamp isEmpty ifTrue: [''] ifFalse: ['; ' , stamp])."
				file nextChunk.
				^ file skipStyleChunk]!

----- Method: MethodHistoryChangeList>>scanCategory:class:meta:stamp: (in category 'all') -----
scanCategory: category class: class meta: meta stamp: stamp
	| method sel |
	self ignoreNonExisting ifTrue: [Smalltalk at: class ifAbsent: [^ self]].
	[
	method _ file nextChunk.
	file skipStyleChunk.
	method size > 0]						"done when double terminators"
		whileTrue:
		[sel _ Parser new parseSelector: method.
		self addItem: (MethodHistoryChangeRecord new class: (class, (meta ifTrue: [' class'] ifFalse: [''])) asSymbol selector: sel stamp: stamp text: method asString sourceFile: file localName)
			text: 'method: ' , class , (meta ifTrue: [' class '] ifFalse: [' '])
				, sel
				, (stamp isEmpty ifTrue: [''] ifFalse: ['; ' , stamp])]!

----- Method: MethodHistoryChangeList>>scanFile:from:to: (in category 'all') -----
scanFile: aFile from: startPosition to: stopPosition
	| itemPosition item prevChar |
	file _ aFile.
	changeList _ OrderedCollection new.
	list _ OrderedCollection new.
	listIndex _ 0.
	file position: startPosition.
'Scanning ', aFile localName, '...'
	displayProgressAt: Sensor cursorPoint
	from: startPosition to: stopPosition
	during: [:bar |
	[file position < stopPosition]
		whileTrue:
		[bar value: file position.
		[file atEnd not and: [file peek isSeparator]]
				whileTrue: [prevChar _ file next].
		(file peekFor: $!!)
		ifTrue:
			[(prevChar = Character cr or: [prevChar = Character lf])
				ifTrue: [self scanCategory]]
		ifFalse:
			[itemPosition _ file position.
			item _ file nextChunk.
			file skipStyleChunk.
			]]].
	listSelections _ Array new: list size withAll: false!

Object subclass: #Authorship
	instanceVariableNames: 'missingDictionary authorDictionary notAccounted database historicalMissingDictionary historicalAuthorDictionary historicalNotAccounted'
	classVariableNames: 'AllMethods'
	poolDictionaries: ''
	category: 'MethodAuthorship'!

!Authorship commentStamp: 'yo 10/13/2008 21:37' prior: 0!
To use this class along with the MethodHistoryDatabase, get the necessary files and put them some directories under the image directory, and evaluate the following in a workspace:

m := MethodHistoryDatabase new.
MethodHistoryChangeList ignoreNonExsiting: false.
m readFile: 'SqueakV1.sources' encodingName: 'mac-roman'.
d := FileDirectory default directoryNamed: 'history-updates'.
#('PreBeta' 'Sqk20Beta') do: [:v |
	m readFilesIn: d updateFile: 'updates.list' versionName: v.].

m readFile: 'SqueakV2.sources' encodingName: 'mac-roman'.
#('Squeak2.0' 'Squeak2.1' 'Squeak2.2beta' 'Squeak2.2' 'Squeak2.3' 'Squeak2.4' 'Squeak2.5test' 'Squeak2.5' 'Squeak2.6alpha' 'Squeak2.6' 'Squeak2.7alpha' 'Squeak2.7' 'Squeak2.8alpha' 'Squeak2.8' 'Squeak2.9alpha') do: [:v |
	m readFilesIn: d updateFile: 'updates.list' versionName: v.].

m readFile: 'SqueakV3.sources' encodingName: 'mac-roman'.
#('Squeak3.0' 'Squeak3.1alpha' 'Squeak3.1beta' 'Squeak3.2alpha' 'Squeak3.2gamma' 'Squeak3.2' 'Squeak3.2.1' 'Squeak3.4alpha' 'Squeak3.4beta' 'Squeak3.4gamma' 'Squeak3.5alpha' 'Squeak3.5beta' 'Squeak3.5gamma' 'Squeak3.6alpha' 'Squeak3.6beta' 'Squeak3.6gamma' 'Squeak3.6') do: [:v |
	m readFilesIn: d updateFile: 'updates.list' versionName: v.].

d := FileDirectory default directoryNamed: 'squeak.org-updates'.
#('Squeak3.7alpha' 'Squeak3.7beta' 'Squeak3.7gamma' 'Squeak3.7' 'Squeak3.8alpha' 'Squeak3.8beta' 'Squeak3.8gamma') do: [:v |
	m readFilesIn: d updateFile: 'SqCupdates.list' versionName: v.].

d := FileDirectory default directoryNamed: 'squeakland.org-updates'.
#('Squeakland 3.1.3905' 'Squeakland 3.1.4295' 'Squeakland 3.2.4913' 'Squeakland 3.8.5976' 'Squeakland05' 'Squeakland 3.8-05') do: [:v |
	m readFilesIn: d updateFile: 'updates.list' versionName: v.].

d := FileDirectory default directoryNamed: 'olpc-updates'.
#('OLPC1.0' 'OLPC2.0') do: [:v |
	m readFilesIn: d updateFile: 'updates.list' versionName: v.].

d := FileDirectory default directoryNamed: 'etoys-updates'.
#('etoys2.1' 'etoys2.2' 'etoys2.3') do: [:v |
	m readFilesIn: d updateFile: 'updates.list' versionName: v.].

m readFile: 'EtoysV3.sources' encodingName: 'utf-8'.
#('etoys3.0' 'etoys3.1' 'etoys3.2') do: [:v |
	m readFilesIn: d updateFile: 'updates.list' versionName: v.].

b := MethodHistoryBrowser new.
b database: m.
MethodHistoryBrowser openBrowserView: (b openEditString: nil) label: 'foo'.

Authorship initialize.
authors := Authorship new.
authors database: m.
missing := authors missingAuthorsWithMethods.
returned := authors returnedAuthorsWithMethods.
notAccounted := authors notAccounted.
historicalMissing := authors historicalMissingAuthorsWithMethods.
historicalNotAccounted := authors historicalNotAccounted.

f _ FileStream newFileNamed: 'currentMissing.html'.
m writeDictWithVersion: missing toHTMLFileNameOn: f title: 'Agreement Missing in Etoys 3.0' explanationFileName: 'missingExplanation.txt'.
f close.

Or for the mainstream image, create appropriate .changes files by doing updates and then:

m := MethodHistoryDatabase new.
MethodHistoryChangeList ignoreNonExsiting: false.
m readFile: 'SqueakV1.sources' encodingName: 'mac-roman'.
d := FileDirectory default directoryNamed: 'history-updates'.
#('PreBeta' 'Sqk20Beta') do: [:v |
	m readFilesIn: d updateFile: 'updates.list' versionName: v.].

m readFile: 'SqueakV2.sources' encodingName: 'mac-roman'.
#('Squeak2.0' 'Squeak2.1' 'Squeak2.2beta' 'Squeak2.2' 'Squeak2.3' 'Squeak2.4' 'Squeak2.5test' 'Squeak2.5' 'Squeak2.6alpha' 'Squeak2.6' 'Squeak2.7alpha' 'Squeak2.7' 'Squeak2.8alpha' 'Squeak2.8' 'Squeak2.9alpha') do: [:v |
	m readFilesIn: d updateFile: 'updates.list' versionName: v.].

m readFile: 'SqueakV3.sources' encodingName: 'mac-roman'.
#('Squeak3.0' 'Squeak3.1alpha' 'Squeak3.1beta' 'Squeak3.2alpha' 'Squeak3.2gamma' 'Squeak3.2' 'Squeak3.2.1' 'Squeak3.4alpha' 'Squeak3.4beta' 'Squeak3.4gamma' 'Squeak3.5alpha' 'Squeak3.5beta' 'Squeak3.5gamma' 'Squeak3.6alpha' 'Squeak3.6beta' 'Squeak3.6gamma' 'Squeak3.6') do: [:v |
	m readFilesIn: d updateFile: 'updates.list' versionName: v.].

d := FileDirectory default directoryNamed: 'squeak.org-updates'.
#('Squeak3.7alpha' 'Squeak3.7beta' 'Squeak3.7gamma' 'Squeak3.7' 'Squeak3.8alpha' 'Squeak3.8beta' 'Squeak3.8gamma') do: [:v |
	m readFilesIn: d updateFile: 'SqCupdates.list' versionName: v.].

m readFile: 'Squeak3.9b-7053.changes' encodingName: 'utf-8'.
m readFile: 'SqueakV39.sources' encodingName: 'utf-8'.
m readFile: 'Squeak39g-7056+3102-7179.changes' encodingName: 'utf-8'.

b := MethodHistoryBrowser new.
b database: m.
MethodHistoryBrowser openBrowserView: (b openEditString: nil) label: 'foo'.

Authorship initialize.
authors := Authorship new.
authors database: m.
missing := authors missingAuthorsWithMethods.
returned := authors returnedAuthorsWithMethods.
notAccounted := authors notAccounted.
historicalMissing := authors historicalMissingAuthorsWithMethods.
historicalNotAccounted := authors historicalNotAccounted.


f _ FileStream newFileNamed: 'currentMissing.html'.
m writeDictWithVersion: missing toHTMLFileNameOn: f title: 'Agreement Missing in Etoys 3.0' explanationFileName: 'missingExplanation.txt'.
f close.

m writeDict: missing toFileName: 'missing.txt'.!

----- Method: Authorship class>>example1 (in category 'as yet unclassified') -----
example1

	| authors missing returned notAccounted |
	Authorship initialize.
	authors := Authorship new.
	missing := authors missingAuthorsWithMethods.
	returned := authors returnedAuthorsWithMethods.
	notAccounted := authors notAccounted.
	^ authors.
!

----- Method: Authorship class>>example2 (in category 'as yet unclassified') -----
example2

	| n i file |
	n := Metaclass allInstances size.
	i _ 0.
	file := FileStream newFileNamed: 'etoysv4.list'.
	'generating the list of existing methods...' displayProgressAt: Sensor cursorPoint from: 1 to: n during: [:bar |
		Metaclass allInstancesDo: [:mc |
			bar value: (i := i + 1).
			mc theNonMetaClass selectors
				do: [:eachSelector |
					(#(DoIt DoItIn:) includes: eachSelector) ifFalse: [
							file nextPutAll: mc theNonMetaClass name; space; nextPutAll: eachSelector; cr]].
			mc  selectors
				do: [:eachSelector |
					(#(DoIt DoItIn:) includes: eachSelector) ifFalse: [
							file nextPutAll: mc name; space; nextPutAll: eachSelector; cr]].
]]!

----- Method: Authorship class>>initialize (in category 'as yet unclassified') -----
initialize
	| n i eachClass |
	super initialize.
	n := Metaclass allInstances size.
	AllMethods := OrderedCollection new.
	i _ 0.
	'Collecting method information...' displayProgressAt: Sensor cursorPoint from: 1 to: n during: [:bar |
		Metaclass allInstancesDo: [:mc |
			bar value: (i := i + 1).
			(eachClass := mc)  selectors
				do: [:eachSelector |
					(#(DoIt DoItIn:) includes: eachSelector) ifFalse: [
						AllMethods
							add: (MethodHistoryChangeRecord new  class: eachClass name selector: eachSelector stamp:  (eachClass compiledMethodAt: eachSelector) timeStamp text: '' sourceFile: '(current)')]].
			(eachClass := mc theNonMetaClass) selectors
				do: [:eachSelector |
					(#(DoIt DoItIn:) includes: eachSelector) ifFalse: [
						AllMethods
							add: (MethodHistoryChangeRecord new  class: eachClass name selector: eachSelector stamp:  (eachClass compiledMethodAt: eachSelector) timeStamp text: '' sourceFile: '(current)')]]]].
!

----- Method: Authorship>>addToHistoricalListIfAuthorHasReturnedSignatory: (in category 'private') -----
addToHistoricalListIfAuthorHasReturnedSignatory: each 

	(historicalAuthorDictionary at: each author ifAbsent: [^nil]) addLast: each!

----- Method: Authorship>>addToHistoricalListIfAuthorIsMissingSignatory: (in category 'private') -----
addToHistoricalListIfAuthorIsMissingSignatory: each 
	(historicalMissingDictionary at: each author ifAbsent: [^nil]) addLast: each!

----- Method: Authorship>>addToListIfAuthorHasReturnedSignatory: (in category 'private') -----
addToListIfAuthorHasReturnedSignatory: each 

	(authorDictionary at: each author ifAbsent: [^nil]) addLast: each!

----- Method: Authorship>>addToListIfAuthorIsMissingSignatory: (in category 'private') -----
addToListIfAuthorIsMissingSignatory: each 
	"author dictionary's value at key k is an OrderedCollection containing the methods 
	written by k"
	(missingDictionary at: each author ifAbsent: [^nil]) addLast: each!

----- Method: Authorship>>agreedContributors (in category 'data') -----
agreedContributors

"This is a list of all Squeak contributors whom Yoshiki Ohshima contacted and get the favorable words, but have not returned a signed distribution agreement yet.

Nov 25th  2008
---

initials         name"
^ #(
'ac'               'Andrew Catton'
'pad'		'Pierre-Andre Dreyfuss'
)!

----- Method: Authorship>>database: (in category 'initialize-release') -----
database: db

	| count eachClass ret1 ret2 |
	database _ db.

	self missingSignatories
		pairsDo: [:initials :name |
			historicalMissingDictionary
				at: initials
				put: (MethodCollection titled: name)].
	self returnedSignatories, self newContributors, self agreedContributors
		pairsDo: [:initials :name |
			historicalAuthorDictionary
				at: initials
				put: (MethodCollection titled: name)].

	count _ 0.
	'collecting information (historical)...' displayProgressAt: Sensor cursorPoint from: 1 to: database size // 100 during: [:bar |
		database keys do: [:k |
			count := count + 1.
			count \\ 100 = 0 ifTrue: [bar value: count//100].
			eachClass := database at: k.
			eachClass do: [:recs |
				recs do: [:rec |
					ret1 := self addToHistoricalListIfAuthorIsMissingSignatory: rec.
					ret2 := self addToHistoricalListIfAuthorHasReturnedSignatory: rec.
				(ret1 == nil and: [ret2 == nil and: [rec author isEmpty not]]) ifTrue: [historicalNotAccounted add: rec]]]]].!

----- Method: Authorship>>historicalMissingAuthorsWithMethods (in category 'filtering') -----
historicalMissingAuthorsWithMethods
	^ historicalMissingDictionary select: [ :eachAssoc | eachAssoc value notEmpty ]!

----- Method: Authorship>>historicalNotAccounted (in category 'filtering') -----
historicalNotAccounted

	^ historicalNotAccounted
!

----- Method: Authorship>>initialize (in category 'initialize-release') -----
initialize
	
	| ret1 ret2 each |
	missingDictionary := Dictionary new.
	authorDictionary := Dictionary new.
	notAccounted := OrderedCollection new.
	historicalMissingDictionary := Dictionary new.
	historicalAuthorDictionary := Dictionary new.
	historicalNotAccounted := OrderedCollection new.
	self missingSignatories
		pairsDo: [:initials :name |
			missingDictionary
				at: initials
				put: (MethodCollection titled: name)].
	self returnedSignatories, self newContributors, self agreedContributors
		pairsDo: [:initials :name |
			authorDictionary
				at: initials
				put: (MethodCollection titled: name)].
	'collecting information...' displayProgressAt: Sensor cursorPoint from: 1 to: AllMethods size // 100 during: [:bar |
		1 to: AllMethods size do: [:i |
			i \\ 100 = 0 ifTrue: [bar value: i//100].
			each := AllMethods at: i.
			"each methodSymbol = #testTwoArgumentEvent ifTrue: [self halt]."
			ret1 := self addToListIfAuthorIsMissingSignatory: each.
			ret2 := self addToListIfAuthorHasReturnedSignatory: each.
			(ret1 == nil and: [ret2 == nil and: [each author isEmpty not]]) ifTrue: [notAccounted add: each]]].
!

----- Method: Authorship>>missingAuthorsWithMethods (in category 'filtering') -----
missingAuthorsWithMethods
	^ missingDictionary select: [ :eachAssoc | eachAssoc value notEmpty ]!

----- Method: Authorship>>missingSignatories (in category 'data') -----
missingSignatories
"This is a list of all Squeak contributors who have not returned a signed distribution agreement.

Nov 25th  2008
---

initials         name"
^ #(
'abc'              '?'
'afr'              'Alejandro Reimondo'
'ag'               'Andreas Gerdes'
'AK'               'Anoulak Kictiraz'
'ak'               'Anoulak Kictiraz'
'AM'               'Aibek Musaev'
'am'               'Aibek Musaev'
'ASF'              'Adam Franco'
'bmk'              'Brian Keefer'
'cE'               'Christian Eitner'
'cm'               'Cesare Marilungo?'
'dik'		'Denis Kudriashov'
'djm'              'Douglas McPherson'
'dls'              'Darryl Smith'
'dns'              'David N. Smith'
'drs'              'Dean Swan'
'dwh'              'Dwight Hughes'
'edt'              '?'
'eldeh'            'Lars Dornheim'
'EP'               '?'
'EW'               'Etan Wexler'
'ff'               'Felix Franz'
'gg'               'Giovanni Giorgi'
'GL'               'Greg Lewin?'
'GVG'              'Greg Gritton'
'gwc'              'Geoff Corey'
'H.Hachisuka'      'Hitoshi Hachisuka'
'hg'               'Henrik Gedenryd'
'hh'               'Helge Horch'
'HJH'              'Hannes Hirzel'
'IT'               'Ian Trudel'
'jbc'              'Jay Casler'
'JDD'              'John David Duncan'
'jdl'              'Jose Laiolo'
'jet'              'John Tobler'
'jj'               '?'
'JLM'              'Jason McVay'
'jlm'              'Jason McVay'
'JO'               'Jonas Oehrn'
'jwh'              'Jim Heyne'
'JZH'              'John (Zhijiang) Han'
'HK'              'Hunter Kelly'
'Kafka'            'Pablo Malavolta'
'los'              'Lothar Schenk'
'mkd'              'Michael Donegan'
'MM'               'Maarten Maartensz'
'mm'               '?'
'mmo'               'Marica Odagaki'
'msk'              'Michael Klein'
'mtf'		'Matthew Fulmer'
'mx'               'Maximialiano Taborda'
'NDCC'             '?'
'mn'               'Mats Nygren'
'nm'		'Nicolas Melin'
'PH'               'Phil Hudson'
'pmm'              'Philippe Marschall?'
'RAH'              'Richard A. Harmon'
'RB'               'Roland Bertuli'
'RCS'              'Russell Swan'
'rej'		'Ralph Johnson'
'RJ'               'Ranjan Bagchi'
'rjf'              'Ricardo J. Ferreira'
'rlf'              'Ricardo J. Ferreira'
'rmf'              'Robert Fure'
'RMF'              'Robert Fure'
'rop'              'Russell Penney'
'rp'              '?'
'rpj'              'Robert P. Jarvis'
'RvL'              'Reinier van Loon'
'sac'              'Scott Crosby'
'SIM'              'Stewart MacLean'
'sjc'              'Sean Charles'
'sk'               'Stefan Kersten'
'slr'              'Steve Rees'
'squeak'           'Henrik Gedenryd'
'TBP'              'Brian Payne'
'Tbp'              'Brian Payne'
'TEM'              'Tom Morgan'
'tm'               '?'
'to'               '?'
'tp'               '?'
'umur'             'Umur Ozkul'
'UO'             'Umur Ozkul'
'wb'               'Wayne Braun'
'wbk'		'Bryce Kampjes'
'wdc'              'Bill Cattey'
'YE'               '?'
'zL'               'Lantz Rowland'
'mvl'		'Martin v. Lowis'
'pf'		'Petr Fischer'
'JPF'		'?'
'ktt'		'?'
'ndCollectionsTests-Unordered'		'?'
'kb'		'Ken Bryant'
'ge'		'?'
'ee'		'Evelyn Eastmond'
'EE'		'Evelyn Eastmond'
'tis'		'Tamara Stern'
'TIS'		'Tamara Stern'
'DaveF'		'Dave Feinburg'
'NB'		'Nick Bushak'
'DS'		'?'
'bss'		'Brian Silverman'
'jens'	'Jens Monig'
'dh'		'Darris Hupp'
'avl'		'?'
'JTN'		'?'
'eo'		'?'
'sc'		'?'
'DSF'	'Dave Feinburg'
'LY'		'?'
'qvl'		'?'
'as'		'?'
'RG'		'?'
'AC'		'Andy Chung'
'swr'		'?'
'e'		'?'
)!

----- Method: Authorship>>newContributors (in category 'data') -----
newContributors

"This is a list of all Squeak contributors who started after the relicensing effort was started and therefore know that the license is under MIT.

Nov 26th  2008
---

initials         name"
^ #(
'aw'               'Alessandro Warth'
'be'			'Bernd Eckardt'
'cjs'			'(from trac)'
'eem'		'Eliot Emilio Miranda'
'jf'			'Jan Fietz'
'lg'               'Luke Gorrie'
'jl'			'Jens Linke'
'JSM'	   'John S Mcintosh'
'thf'			'an Impara employee'
'sjg'			'Simon Guest'
'kph'		'Keith Hodges'
'kks'            'kks'
'meta-auto'	'generated code'
'programmatic'     'generated code'
'wbk'		'Bryce Kampjes'
)!

----- Method: Authorship>>notAccounted (in category 'filtering') -----
notAccounted

	^ notAccounted
!

----- Method: Authorship>>overlap (in category 'filtering') -----
overlap

	| returned missing |
	returned := OrderedCollection new: 100.
	(self returnedSignatories, self newContributors, self agreedContributors) pairsDo: [:initials :name |
		returned add: initials.
	].
	missing := OrderedCollection new: 100.
	self missingSignatories pairsDo: [:initials :name |
		missing add: initials.
	].
	^ missing asSet intersection: returned asSet!

----- Method: Authorship>>returnedAuthorsWithMethods (in category 'filtering') -----
returnedAuthorsWithMethods
	^ authorDictionary select: [ :eachAssoc | eachAssoc value notEmpty ]!

----- Method: Authorship>>returnedSignatories (in category 'data') -----
returnedSignatories

"This is a list of all Squeak contributors who have returned a signed distribution agreement.

Nov 25th  2008
---

initials         name"
^ #(
'AB'               'Alexandre Bergel'
'ab'               'Avi Bryant or Alexandre Bergel'
'ACG'              'Andrew C. Greenberg'
'acg'              'Andrew C. Greenberg'
'ack'              'Alan Kay'
'ads'              'Adam Spitz'
'AFi'              'Alain Fischer'
'ajh'              'Anthony Hannan'
'aka'              'Mark Guzdial'
'al'               'Adrian Lienhard or Alexander Lazarevic'
'aoy'              'Andres Otaduy'
'apb'              'Andrew P. Black'
'apl'              'Alain Plantec'
'ar'               'Andreas Raab'
'???'               'Andreas Raab'
'asm'              'Alejandro Magistrello'
'avi'              'Avi Bryant'
'ba'			'Bob Arning'
'bf'               'Bert Freudenberg'
'BEO'              'Bruce O''Neel '
'beo'              'Bruce O''Neel '
'BG'               'Boris Gaertner'
'bg'               'Boris Gaertner'
'bh'               'Bob Hartwig'
'BJP'              'Bijan Parsia'
'BJP
9/9/1998'              'Bijan Parsia'
'bk'              'Bolot Kerimbaev'
'bkv'              'Brent Vukmer'
'bob'			'Bob Arning'
'bolot'            'Bolot Kerimbaev'
'bootstrap'        'Pavel Krivanek'
'BP'               'Brent Pinkney'
'bp'               'Brent Pinkney or Bernhard Pieber'
'brp'              'Brent Pinkney'
'brp`'              'Brent Pinkney'
'btr'              'Brian Rice'
'bvs'              'Ben Schroeder'
'cbc'              'Chris Cunningham'
'ccn'              'Chris Norton'
'ccn+ceg'          'Chris Norton and Carl Gundel'
'ceg'       'Carl Gundel'
'CdG'              'Cees de Groot'
'cds'              'C. David Shaffer'
'chronograph'               'Tetsuya Hayashi'
'cmm'              'Chris Muller'
'crl'              'Craig Latta'
'cwp'              'Colin Putney'
'daf'              'Dave Faught'
'dao'              'danil osipchuk'
'das'              'David A Smith'
'DAS'              'David A Smith'
'dc'               'Damien Cassou'
'dd'               'Dominique Dutoit'
'de'               'Scott Wallace'
'dew'              'Doug Way'
'DF'               'Diego Fernandez'
'dgd'              'Diego Gomez Deck'
'dhhi'             'Dan Ingalls'
'di'               'Dan Ingalls'
'di
'               'Dan Ingalls'
'6/5/97'               'Dan Ingalls'
'6/6/97'               'Dan Ingalls'
'6/7/97'               'Dan Ingalls'
'6/8/97'               'Dan Ingalls'
'6/9/97'               'Dan Ingalls'
'6/10/97'               'Dan Ingalls'
'6/11/97'               'Dan Ingalls'
'6/13/97'               'Dan Ingalls'
'6/18/97'               'Dan Ingalls'
'djp'              'David J. Pennell'
'DM'               'Duane Maxwell'
'dm'               'Duane Maxwell/EntryPoint'
'DSM'              'Duane Maxwell'
'DSM
10/15/1999'              'Duane Maxwell'
'drm'              'Delbert Murphy'
'dtl'              'Dave Lewis'
'dv'              'Daniel Vainsencher'
'dvf'              'Daniel Vainsencher'
'dvf
6/10/2000'              'Daniel Vainsencher'
'eat'              'Eric Arseneau Tremblay'
'edc'              'Edgar DeCleene or Marcus Denker'
'efc'              'Eddie Cottongim'
'efo'              'Emilio Oca'
'em'               'Ernest Micklei?'
'emm'              'Ernest Micklei'
'es'               'Enrico Spinielli'
'fbs'              'Frank Shearar'
'FBS'              'Frank Shearar'
'fbs'              'Frank Shearar'
'fc'               'Frank Caggiano'
'fcs'              'Frank Sergeant'
'fm'               'Florin Mateoc'
'gh'               'Goran Krampe (nee Hultgren)'
'gk'               'Goran Krampe (nee Hultgren)'
'gm'               'German Morales'
'go'               'Georg Gollmann'
'gsa'              'German Arduino'
'HEG'              'Henrik Ekenberg'
'HilaireFernandes' 'Hilaire Fernandes'
'hk'               'Herbert Konig'
'hmm'              'Hans-Martin Mosner'
'hpt'              'Hernan Tylim'
'huma'             'Lyndon Tremblay'
'ich.'             'Yuji Ichikawa'
'ikp'              'Ian Piumarta'
'jaf'              'Jan Fietz'
'jam'              'Javier Musa'
'jb'              'Jim Benson'
'jcg'              'Joshua Gargus'
'jdf'              'David Farber'
'jdr'              'Javier Diaz-Reinoso'
'je'               'Joern Eyrich'
'je77'             'Jochen Rick'
'JF'               'Julian Fitzell'
'jf'               'Julian Fitzell'
'jhm'              'John Maloney'
'jm'              'John Maloney'
'jm
'              'John Maloney'
'jla'              'Jerry Archibald'
'jlb'              'Jim Benson'
'jmb'              'Hans Baveco'
'JMM'              'John McIntosh'
'JMV'              'Juan Manuel Vuletich'
'jmv'              'Juan Manuel Vuletich'
'jon'              'Jon Hylands'
'JP'               'Joseph Pelrine'
'jp'               'Joseph Pelrine'
'jrm'              'John-Reed Maffeo'
'jrp'              'John Pierce'
'jsp'              'Jeff Pierce'
'JW'               'Jesse Welton'
'jws'			'John Sarkela'
'JWS'		'John Sarkela'
'ka'               'Kazuhiro Abe'
'kfr'              'Karl Ramberg'
'KLC'              'Ken Causey'
'klc'              'Ken Causey'
'KR'               'korakurider'
'KTT'              'Kurt Thams'
'kwl'              'Klaus D. Witzel'
'ky'               'Koji Yokokawa'
'laza'             'Alexander Lazarevic'
'LB'               'Leo Burd'
'LC'               'Leandro Caniglia'
'lc'               'Leandro Caniglia'
'LEG'              'Gerald Leeb'
'len'              'Luciano Esteban Notarfrancesco'
'lr'               'Lukas Renggli'
'lrs'              'Lorenzo Schiavina'
'ls'               'Lex Spoon'
'LS'               'Lex Spoon'
'm3r'              'Maurice Rabb'
'MAL'              'Michael Latta'
'mas'              'Mark Schwenk'
'm'                'Marcus Denker'
'MD'               'Marcus Denker'
'md'               'Marcus Denker'
'md\'              'Marcus Denker'
'mdr'              'Mike Rutenberg'
'mga'              'Markus Galli'
'miki'             'Mikael Kindborg'
'mikki'            'Mikael Kindborg'
'mir'              'Michael Rueger'
'mist'             'Michal Starke'
'MJG'              'Mark Guzdial'
'mjg'              'Mark Guzdial'
'mjg
8/31/1998'              'Mark Guzdial'
'mjg
9/9/1998'              'Mark Guzdial'
'mjg
9/23/1998'              'Mark Guzdial'
'mjr'              'Mike Roberts'
'mjt'              'Mike Thomas'
'mk'               'Matej Kosik'
'mlr'              'Michael Rueger'
'MPW'              'Marcel Weiher'
'mpw'              'Marcel Weiher'
'mrm'              'Martin McClure'
'MPH'              'Michael Hewner'
'MU'               'Masashi Umezawa'
'mu'               'Masashi Umezawa'
'mw'               'Martin Wirblat'
'nb'               'Naala Brewer'
'nice'             'Nicolas Cellier'
'nk'               'Ned Konz'
'nop'              'Jay Carlson'
'Noury'            'Noury Bouraqadi'
'NS'               'Nathanael Schaerli'
'panda'            'Michael Rueger'
'PHK'              'Peter Keeler'
'pk'               'Pavel Krivanek'
'pm'               'Patrick Mauritz'
'pnm'              'Paul McDonough'
'pnm
8/23/2000'              'Paul McDonough'
'RAA'              'Bob Arning'
'RAA
3/28/2000'              'Bob Arning'
'r++'              'Gerardo Richarte'
'raa'              'Bob Arning'
'raok'             'Richard A. O''Keefe'
'rbb'              'Brian Brown'
'rca'              'Russell Allen'
'reThink'          'Paul McDonough'
'rew'              'Roger Whitney'
'rhi'              'Robert Hirschfeld'
'rh'              'Robert Hirschfeld'
'Rik'              'Rik Fischer SmOOdy'
'rk'               'Ram Krishnan'
'rkris'               'Ram Krishnan'
'RJT'              'Ron Teitelbaum'
'RM'			'Rick McGeer'
'rr'               'Romain Robbes'
'rw'               'Roel Wuyts'
'rw'              'Robert Withers'
'rww'              'Robert Withers'
'sbw'              'Stephan B. Wessels'
'SD'               'Stephane Ducasse'
'sd'               'Stephane Ducasse'
'stephaneducassse'               'Stephane Ducasse'
'sge'              'Steve Elkins'
'shrink'           'Pavel Krivanek'
'slg'              'Steve Gilbert'
'sm'               'Simon Michael'
'sma'              'Stefan Matthias Aust'
'sn'               'Suslov Nikolay'
'spfa'             'Stephane Rollandin'
'sps'              'Steven Swerling'
'sqr'              'Andres Valloud'
'SqR'              'Andres Valloud'
'SqR!!!!'            'Andres Valloud'
'SqR!!!!!!!!'         'Andres Valloud'
'sr'               'Stephan Rudlof'
'ssa'              'Sam S. Adams'
'Sames'            'Samuel S. Shuster'
'SSS'              'Samuel S. Shuster'
'st'               'Samuel Tardieu'
'stephaneducasse'  'Stephane Ducasse'
'stp'              'Stephen Travis Pope'
'sumim'            'Masato Sumi'
'svp'              'Stephen Vincent Pair'
'sw'               'Scott Wallace'
'sws'              'Scott Wallace'
'T2'               'Toshiyuki Takeda'
'tak'              'Takashi Yamamiya'
'tao'              'Tim Olson'
'tb'               'Todd Blanchard or Torsten Bergman'
'TBn'              'Torsten Bergmann'
'tbn'              'Torsten Bergmann'
'tetha'            'Tetsuya Hayashi'
'tfei'             'The Fourth Estate, Inc.'
'th'               'Torge Husfeldt'
'ti'               'Tobias Isenberg'
'TJ'               'TJ Leone'
'tk'               'Ted Kaehler'
'tk
9/13/97'               'Ted Kaehler'
'tk
12/6/2004'               'Ted Kaehler'
'tk
11/29/2004'               'Ted Kaehler'
'tk
11/26/2004'               'Ted Kaehler'
'tk'               'Thomas Kowark'
'tlk'              'Tom Koenig'
'TN'               'korakurider'
'tonyg'		'Tony Garnock-Jones'
'TPR'              'Tim Rowledge'
'tpr'              'Tim Rowledge'
'TAG'              'Travis Griggs'
'TRee'             'Trygve Reenskaug'
'ts'          'Shortsleeved'
'Tsutomu'          'Tsutomu Hiroshima'
'tween'            'Andy Tween'
'vb'               'Vassili Bykov'
'vbdew'               'Vassili Bykov and Doug Way'
'vj'               'Vladimir Janousek'
'wiz'              'Jerome Peace'
'wod'              'Bill Dargel'
'ykoubo'           'Koji Yokokawa'
'yo'               'Yoshiki Ohshima'
'ward'             'Ward Cunningham'
'zz'               'Serge Stinckwich'
)!

Object subclass: #MethodHistoryDatabase
	instanceVariableNames: 'dictionary'
	classVariableNames: 'LiveLists Databases'
	poolDictionaries: ''
	category: 'MethodAuthorship'!

----- Method: MethodHistoryDatabase class>>at:put: (in category 'all') -----
at: aVersionName put: aDatabase

	^ self databases at: aVersionName put: aDatabase.
!

----- Method: MethodHistoryDatabase class>>databases (in category 'all') -----
databases

	^ Databases ifNil: [Databases := Dictionary new].
!

----- Method: MethodHistoryDatabase class>>liveListAt:putFromFileName: (in category 'all') -----
liveListAt: dataName putFromFileName: fileName

	| file strs meta cls meth dic |
	dic := IdentityDictionary new.
	file := FileStream readOnlyFileNamed: fileName.
	file wantsLineEndConversion: true.
	file contentsOfEntireFile linesDo: [:line |
		strs := line substrings.
		meta := strs size = 3.
		cls := strs first, (meta ifTrue: [' class'] ifFalse: ['']).
		meth := strs last.
		(dic at: cls asSymbol ifAbsentPut: [IdentitySet new]) add: meth asSymbol.
	].
	file close.
	self liveLists at: dataName put: dic.
!

----- Method: MethodHistoryDatabase class>>liveLists (in category 'all') -----
liveLists

	^ LiveLists ifNil: [LiveLists := Dictionary new].
!

----- Method: MethodHistoryDatabase class>>named: (in category 'all') -----
named: aVersionName

	^ self databases at: aVersionName ifAbsent: [nil].
!

----- Method: MethodHistoryDatabase class>>remove: (in category 'all') -----
remove: aVersionName

	^ self databases removeKey: aVersionName ifAbsent: [nil].!

----- Method: MethodHistoryDatabase>>at: (in category 'all') -----
at: className

	^ dictionary at: className ifAbsent: [^ Dictionary new].
!

----- Method: MethodHistoryDatabase>>at:at: (in category 'all') -----
at: className at: sel

	dictionary at: className ifPresent: [:dict | dict at: sel ifPresent: [:col | ^ col]].
	^ Array new.
!

----- Method: MethodHistoryDatabase>>initialize (in category 'all') -----
initialize

	super initialize.
	dictionary := IdentityDictionary new.
!

----- Method: MethodHistoryDatabase>>keys (in category 'all') -----
keys

	^ dictionary keys
!

----- Method: MethodHistoryDatabase>>processChangesFile:encoding: (in category 'all') -----
processChangesFile: aFilename encoding: encodingString

	| aStream c |
	aStream := FileStream readOnlyFileNamed: aFilename.
	aStream converter: (TextConverter newForEncoding: encodingString).
	c := MethodHistoryChangeList new.
	c scanFile: aStream from: 0 to: aStream size.
	c removeDoIts.
	aStream close.
	^ c.
!

----- Method: MethodHistoryDatabase>>processChangesList: (in category 'all') -----
processChangesList: aCollection
"
	'Processing...' displayProgressAt: Display center from: 1 to: aCollection changeList size during: [:bar |
		aCollection changeList withIndexDo: [:record :ind |
			bar value: ind.
			self processRecord: record.
		].
	]."

	aCollection changeList do: [:record |
		self processRecord: record]
!

----- Method: MethodHistoryDatabase>>processLiveListNamed: (in category 'all') -----
processLiveListNamed: aFileName

	| file |
	file := FileStream readOnlyFileNamed: aFileName.
	file wantsLineEndConversion: true.
	file linesDo: [:line |
		self processLiveMethod: line
	].
	file close.
!

----- Method: MethodHistoryDatabase>>processLiveMethod: (in category 'all') -----
processLiveMethod: aString

	| strs meta cls meth |
	strs := aString substrings.
	meta := strs size = 3.
	cls := strs first, (meta ifTrue: [' class'] ifFalse: ['']).
	meth := strs last.
	(self live at: cls asSymbol ifAbsentPut: [IdentitySet new]) add: meth asSymbol.
!

----- Method: MethodHistoryDatabase>>processRecord: (in category 'all') -----
processRecord: rec

	| col clsName sel cls |
	cls := rec methodClass.
	cls ifNil: [^ self].
	clsName := cls asSymbol.
	sel := rec methodSelector.
	sel ifNil: [^ self].
		dictionary at: clsName ifAbsent: [
dictionary at: clsName put: IdentityDictionary new].
	(dictionary at: clsName) at: sel ifAbsent: [(dictionary at: clsName) at: sel put: OrderedCollection new].

	col := (dictionary at: clsName) at: sel.
	col ifEmpty:  [col addFirst: rec]
		ifNotEmpty: [(col first equals: rec) ifFalse: [col addFirst: rec]].
	
	"col detect: [:old | old equals: rec] ifNone: [
		col addFirst: rec
	]."
!

----- Method: MethodHistoryDatabase>>readFile:encodingName: (in category 'all') -----
readFile: aFilename encodingName: encodingName

	| c |
	"Transcript show: 'reading... ', aFilename; cr."
	c := self processChangesFile: aFilename encoding: encodingName.
	self processChangesList: c.
!

----- Method: MethodHistoryDatabase>>readFilesIn:updateFile:versionName: (in category 'all') -----
readFilesIn: dir updateFile: updateFileName versionName: versionName

	| updates more line file encoding |
	updates := dir readOnlyFileNamed: updateFileName.
	more := true.
	[more] whileTrue: [
		updates atEnd ifTrue: [updates close. ^ self].
		line := updates upTo: Character cr.
		line ifNil: [updates close. ^ self].
		line size > 0 ifTrue: [
			line first = $# ifTrue: [
				(line copyFrom: 2 to: line size) = versionName ifTrue: [more := false]].
		].
	].
	more := true.
	[more] whileTrue: [
		updates atEnd ifTrue: [updates close. ^ self].
		line := updates upTo: Character cr.
		line ifNil: [^ self].
		(line first = $#) ifTrue: [^ self].
		file := dir readOnlyFileNamed: line.
		file binary.
		encoding := ((file next: 3) = (ByteArray with: 16rEF with: 16rBB with: 16rBF)) ifTrue: ['utf-8'] ifFalse: ['mac-roman'].
		self readFile: file fullName encodingName: encoding.
	].
!

----- Method: MethodHistoryDatabase>>size (in category 'all') -----
size

	^ dictionary size.
!

----- Method: MethodHistoryDatabase>>sourceCodeAt:at: (in category 'all') -----
sourceCodeAt: className at: sel

	dictionary at: className ifPresent: [:dict | dict at: sel ifPresent: [:col | ^ col first text]].
	^ ''
!

----- Method: MethodHistoryDatabase>>writeDict:toFileName: (in category 'all') -----
writeDict: aDict toFileName: aFileName

	| f |
	f := FileStream newFileNamed: aFileName.
	aDict keys asSortedCollection do: [:k |
		f nextPutAll: (aDict at: k) printString; cr.
	].
	f close.
!

----- Method: MethodHistoryDatabase>>writeDictWithVersion:toHTMLFileNameOn:title: (in category 'all') -----
writeDictWithVersion: aDict toHTMLFileNameOn: aStream title: aString

	self writeDictWithVersion: aDict toHTMLFileNameOn: aStream title: aString explanationFileName: nil.
!

----- Method: MethodHistoryDatabase>>writeDictWithVersion:toHTMLFileNameOn:title:explanationFileName: (in category 'all') -----
writeDictWithVersion: aDict toHTMLFileNameOn: aStream title: aString explanationFileName: explanation

	| entries current prev history firstPart secondPart diffString oldStamp newStamp |
	firstPart _ WriteStream on: (String new: 10).
	secondPart _ WriteStream on: (String new: 10).
	aStream nextPutAll: '<html><head>'.
	aStream nextPutAll: '<title>'.
	aStream nextPutAll: aString.
	aStream nextPutAll: '</title></head><body>'.
	aStream cr.
	aStream nextPutAll: '<H2>'.
	aStream nextPutAll: aString.
	aStream nextPutAll: '</H2>'.
	aStream cr.
	explanation ifNotNil: [
		aStream nextPutAll: (FileStream readOnlyFileNamed: explanation) contentsOfEntireFile].

	aDict keys asSortedCollection do: [:k |
		entries _ aDict at: k.
		entries do: [:m |
			history := self at: m methodClass asSymbol at: m methodSelector.
			current _ history size > 0 ifTrue: [history first text] ifFalse: [''].
			prev _ history size > 1 ifTrue: [history second text] ifFalse: [''].
			firstPart nextPutAll: '<A HREF="#'.
			firstPart nextPutAll: m methodClass asString, '-', m methodSelector asString.
			firstPart nextPutAll: '">'.
			firstPart nextPutAll: m methodClass, '>>', m methodSelector.
			firstPart nextPutAll: '</A><BR>'.
			firstPart nextPut: Character cr.
			secondPart nextPutAll: '<A NAME="'.
			secondPart nextPutAll: m methodClass asString, '-', m methodSelector asString.
			secondPart nextPutAll: '">'.
			secondPart nextPutAll: '<table border=1 vspace=5px width=90%>'.
			secondPart nextPutAll: '<tr><td>'.
			secondPart nextPutAll: m methodClass asString, '>>', m methodSelector asString.
			oldStamp := history size > 1 ifTrue: [history second stamp] ifFalse: [''].
			oldStamp ifEmpty: [oldStamp := 'no stamp'].
			newStamp := history size > 0 ifTrue: [history first stamp] ifFalse: [''].
			newStamp ifEmpty: [newStamp := 'no stamp'].
			secondPart nextPutAll: ': ('.
			secondPart nextPutAll: oldStamp.
			secondPart nextPutAll: ' -> '.
			secondPart nextPutAll: newStamp.
			secondPart nextPutAll: ')'.
			secondPart nextPutAll: '<tr><td><pre>'.
			secondPart nextPutAll: (prev ifEmpty: ['no previous history'] ifNotEmpty: [TextDiffBuilder buildHTMLPatchFrom: prev asHtmlNOBR to: prev asHtmlNOBR]).
			secondPart nextPutAll: '</pre></td></tr>'.
			secondPart nextPut: Character cr.
			secondPart nextPutAll: '<tr><td><pre>'.
			secondPart nextPutAll: (current ifEmpty: ['not found'] ifNotEmpty: [TextDiffBuilder buildHTMLPatchFrom: current asHtmlNOBR to: current asHtmlNOBR]).
			secondPart nextPutAll: '</pre></td></tr>'.
			(prev size > 0 and: [current size > 0]) ifTrue: [
				diffString := TextDiffBuilder buildHTMLPatchFrom: prev asHtmlNOBR to: current asHtmlNOBR.
				secondPart nextPutAll: '<tr><td><pre>'.
				secondPart nextPutAll: diffString.
				secondPart nextPutAll: '</pre></td></tr>'.
			].
			secondPart nextPutAll: '</table>'.
			secondPart nextPut: Character cr.
			secondPart cr.
		].
	].
	aStream nextPutAll: firstPart contents.
	aStream cr.
	aStream nextPutAll: secondPart contents.

	aStream nextPutAll: '</body></html>'.
!

----- Method: String>>asHtmlNOBR (in category '*methodauthorship') -----
asHtmlNOBR
	"Do the basic character conversion for HTML.  Leave all original return 
	and tabs in place, so can conver back by simply removing bracked 
	things. 4/4/96 tk"
	| temp |
	temp _ self copyReplaceAll: '&' with: '&amp;'.
	HtmlEntities keysAndValuesDo:
		[:entity :char |
		char = $& ifFalse:
			[temp _ temp copyReplaceAll: char asString with: '&' , entity , ';']].
	temp _ temp copyReplaceAll: '	' with: '&nbsp;&nbsp;&nbsp;&nbsp;'.
	^ temp

"
	'A<&>B' asHtml
"!

VersionsBrowser subclass: #MethodHistoryVersionBrowser
	instanceVariableNames: 'database'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'MethodAuthorship'!

----- Method: MethodHistoryVersionBrowser class>>browseVersionsOf:class:meta:category:selector:database: (in category 'as yet unclassified') -----
browseVersionsOf: method class: class meta: meta category: msgCategory selector: selector database: database
	^ self new class: class meta: meta selector: selector database: database
!

----- Method: MethodHistoryVersionBrowser>>class:meta:selector:database: (in category 'all') -----
class: cls meta: isMeta selector: sel database: db
	| c |
	database := db.
	classOfMethod _ cls.
	selectorOfMethod _ sel.
	list _ database at: (classOfMethod name, (isMeta ifTrue: [' class'] ifFalse: ['']))  asSymbol at: selectorOfMethod.
	c := MethodHistoryChangeList new.
	list do: [:l |
		c addItem: l text: (l stamp ifNotEmpty: [l stamp] ifEmpty: ['no stamp']), ' (', l fileName, ')'].
	c initializeForDatabase.
	MethodHistoryChangeList open: c name: 'Recent versions of ' , sel multiSelect: false.
!

----- Method: MethodHistoryVersionBrowser>>reformulateList (in category 'all') -----
reformulateList
	| col |
	col := database at: classOfMethod asSymbol at: selectorOfMethod.
	col ifEmpty: [^ self].

	list _ col.
	listIndex _ 1.
	self changed: #listIndex.
	self contentsChanged
!

----- Method: TextDiffBuilder class>>buildHTMLPatchFrom:to: (in category '*methodauthorship') -----
buildHTMLPatchFrom: srcString to: dstString
	^(self from: srcString to: dstString) buildHTMLDisplayPatch!

----- Method: TextDiffBuilder>>buildHTMLDisplayPatch (in category '*methodauthorship') -----
buildHTMLDisplayPatch
	^String streamContents:[:stream|
		self printPatchHTMLSequence: self buildPatchSequence on: stream.
	]!

----- Method: TextDiffBuilder>>printPatchHTMLSequence:on: (in category '*methodauthorship') -----
printPatchHTMLSequence: seq on: aStream 
	| attrs |
	seq do: 
		[:assoc | 
			attrs _ self attributesOf: assoc key.
			attrs do: [:attribute |
				(attribute isMemberOf: TextColor) ifTrue: [
					aStream nextPutAll: '<span style="color: '; nextPutAll: attribute color asHTMLColor; nextPutAll: '">'
				].
				((attribute isMemberOf: TextEmphasis) and: [attribute emphasisCode = 16]) ifTrue: [
					aStream nextPutAll: '<STRIKE>'
				].
			].
			aStream nextPutAll: assoc value; cr.
			attrs reverseDo: [:attribute |
				(attribute isMemberOf: TextColor) ifTrue: [
					aStream nextPutAll: '</span>'
				].
				((attribute isMemberOf: TextEmphasis) and: [attribute emphasisCode = 16]) ifTrue: [
					aStream nextPutAll: '</STRIKE>'
				].
			].
		].!



More information about the Packages mailing list