MCStReader.st
author Claus Gittinger <cg@exept.de>
Sat, 20 Aug 2011 13:43:28 +0200
changeset 209 780f37190c97
parent 41 7bf947de2da2
child 308 e7ea1f4fb7fb
permissions -rw-r--r--
added: #version_CVS
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
41
7bf947de2da2 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     1
"{ Package: 'stx:goodies/monticello' }"
7bf947de2da2 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     2
7bf947de2da2 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     3
MCSnapshotReader subclass:#MCStReader
7bf947de2da2 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     4
	instanceVariableNames:''
7bf947de2da2 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     5
	classVariableNames:''
7bf947de2da2 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     6
	poolDictionaries:''
7bf947de2da2 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     7
	category:'Monticello-Chunk Format'
7bf947de2da2 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     8
!
7bf947de2da2 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     9
7bf947de2da2 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    10
7bf947de2da2 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    11
!MCStReader class methodsFor:'as yet unclassified'!
7bf947de2da2 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    12
7bf947de2da2 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    13
extension
7bf947de2da2 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    14
	^ 'st'
7bf947de2da2 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    15
! !
7bf947de2da2 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    16
7bf947de2da2 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    17
!MCStReader methodsFor:'as yet unclassified'!
7bf947de2da2 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    18
7bf947de2da2 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    19
addDefinitionsFromDoit: aString
209
780f37190c97 added: #version_CVS
Claus Gittinger <cg@exept.de>
parents: 41
diff changeset
    20
	| parser |
780f37190c97 added: #version_CVS
Claus Gittinger <cg@exept.de>
parents: 41
diff changeset
    21
	(parser := MCDoItParser forDoit: aString) ifNotNil:
780f37190c97 added: #version_CVS
Claus Gittinger <cg@exept.de>
parents: 41
diff changeset
    22
		[
41
7bf947de2da2 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    23
		parser addDefinitionsTo: definitions]
7bf947de2da2 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    24
!
7bf947de2da2 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    25
7bf947de2da2 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    26
categoryFromDoIt: aString
7bf947de2da2 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    27
	| tokens  |
209
780f37190c97 added: #version_CVS
Claus Gittinger <cg@exept.de>
parents: 41
diff changeset
    28
	tokens := Scanner new scanTokens: aString.
41
7bf947de2da2 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    29
	tokens size = 3 ifFalse: [self error: 'Unrecognized category definition'].
7bf947de2da2 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    30
	^ tokens at: 3
7bf947de2da2 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    31
!
7bf947de2da2 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    32
7bf947de2da2 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    33
classDefinitionFrom: aPseudoClass
209
780f37190c97 added: #version_CVS
Claus Gittinger <cg@exept.de>
parents: 41
diff changeset
    34
	| tokens traitCompositionString lastIndex classTraitCompositionString |
780f37190c97 added: #version_CVS
Claus Gittinger <cg@exept.de>
parents: 41
diff changeset
    35
	tokens := Scanner new scanTokens: aPseudoClass definition.
780f37190c97 added: #version_CVS
Claus Gittinger <cg@exept.de>
parents: 41
diff changeset
    36
	traitCompositionString := ((ReadStream on: aPseudoClass definition)
780f37190c97 added: #version_CVS
Claus Gittinger <cg@exept.de>
parents: 41
diff changeset
    37
		match: 'uses:';
780f37190c97 added: #version_CVS
Claus Gittinger <cg@exept.de>
parents: 41
diff changeset
    38
		upToAll: 'instanceVariableNames:') withBlanksTrimmed.
780f37190c97 added: #version_CVS
Claus Gittinger <cg@exept.de>
parents: 41
diff changeset
    39
	classTraitCompositionString := ((ReadStream on: aPseudoClass metaClass definition asString)
780f37190c97 added: #version_CVS
Claus Gittinger <cg@exept.de>
parents: 41
diff changeset
    40
		match: 'uses:';
780f37190c97 added: #version_CVS
Claus Gittinger <cg@exept.de>
parents: 41
diff changeset
    41
		upToAll: 'instanceVariableNames:') withBlanksTrimmed.
780f37190c97 added: #version_CVS
Claus Gittinger <cg@exept.de>
parents: 41
diff changeset
    42
	traitCompositionString isEmpty ifTrue: [traitCompositionString := '{}'].
780f37190c97 added: #version_CVS
Claus Gittinger <cg@exept.de>
parents: 41
diff changeset
    43
	classTraitCompositionString isEmpty ifTrue: [classTraitCompositionString := '{}'].
780f37190c97 added: #version_CVS
Claus Gittinger <cg@exept.de>
parents: 41
diff changeset
    44
	lastIndex := tokens size.
41
7bf947de2da2 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    45
	^ MCClassDefinition
7bf947de2da2 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    46
		name: (tokens at: 3)
7bf947de2da2 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    47
		superclassName: (tokens at: 1)
209
780f37190c97 added: #version_CVS
Claus Gittinger <cg@exept.de>
parents: 41
diff changeset
    48
		traitComposition: traitCompositionString
780f37190c97 added: #version_CVS
Claus Gittinger <cg@exept.de>
parents: 41
diff changeset
    49
		classTraitComposition: classTraitCompositionString
780f37190c97 added: #version_CVS
Claus Gittinger <cg@exept.de>
parents: 41
diff changeset
    50
		category: (tokens at: lastIndex)
780f37190c97 added: #version_CVS
Claus Gittinger <cg@exept.de>
parents: 41
diff changeset
    51
		instVarNames: ((tokens at: lastIndex - 6) findTokens: ' ')
780f37190c97 added: #version_CVS
Claus Gittinger <cg@exept.de>
parents: 41
diff changeset
    52
		classVarNames: ((tokens at: lastIndex - 4) findTokens: ' ')
780f37190c97 added: #version_CVS
Claus Gittinger <cg@exept.de>
parents: 41
diff changeset
    53
		poolDictionaryNames: ((tokens at: lastIndex - 2) findTokens: ' ')
41
7bf947de2da2 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    54
		classInstVarNames: (self classInstVarNamesFor: aPseudoClass)
7bf947de2da2 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    55
		type: (self typeOfSubclass: (tokens at: 2))
7bf947de2da2 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    56
		comment: (self commentFor: aPseudoClass)
7bf947de2da2 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    57
		commentStamp: (self commentStampFor: aPseudoClass)
7bf947de2da2 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    58
!
7bf947de2da2 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    59
7bf947de2da2 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    60
classInstVarNamesFor: aPseudoClass
7bf947de2da2 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    61
	| tokens |
209
780f37190c97 added: #version_CVS
Claus Gittinger <cg@exept.de>
parents: 41
diff changeset
    62
	
780f37190c97 added: #version_CVS
Claus Gittinger <cg@exept.de>
parents: 41
diff changeset
    63
	self flag: #traits.
41
7bf947de2da2 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    64
	aPseudoClass metaClass hasDefinition ifFalse: [^ #()].
209
780f37190c97 added: #version_CVS
Claus Gittinger <cg@exept.de>
parents: 41
diff changeset
    65
	tokens := Scanner new scanTokens: aPseudoClass metaClass definition.
780f37190c97 added: #version_CVS
Claus Gittinger <cg@exept.de>
parents: 41
diff changeset
    66
	"tokens size = 4 ifFalse: [self error: 'Unrecognized metaclass definition']."
41
7bf947de2da2 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    67
	^ tokens last findTokens: ' '
7bf947de2da2 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    68
!
7bf947de2da2 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    69
7bf947de2da2 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    70
commentFor: aPseudoClass
7bf947de2da2 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    71
	| comment |
209
780f37190c97 added: #version_CVS
Claus Gittinger <cg@exept.de>
parents: 41
diff changeset
    72
	comment := aPseudoClass organization classComment.
41
7bf947de2da2 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    73
	^ comment asString = ''
7bf947de2da2 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    74
		ifTrue: [comment]
7bf947de2da2 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    75
		ifFalse: [comment string]
7bf947de2da2 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    76
!
7bf947de2da2 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    77
7bf947de2da2 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    78
commentStampFor: aPseudoClass
7bf947de2da2 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    79
	| comment |
209
780f37190c97 added: #version_CVS
Claus Gittinger <cg@exept.de>
parents: 41
diff changeset
    80
	comment := aPseudoClass organization classComment.
41
7bf947de2da2 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    81
	^  [comment stamp] on: MessageNotUnderstood do: [nil]
7bf947de2da2 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    82
!
7bf947de2da2 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    83
7bf947de2da2 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    84
methodDefinitionsFor: aPseudoClass
7bf947de2da2 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    85
	^ aPseudoClass selectors collect: 
7bf947de2da2 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    86
		[:ea |
7bf947de2da2 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    87
		 MCMethodDefinition
7bf947de2da2 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    88
			className: aPseudoClass name
7bf947de2da2 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    89
			classIsMeta: aPseudoClass isMeta
7bf947de2da2 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    90
			selector: ea
7bf947de2da2 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    91
			category: (aPseudoClass organization categoryOfElement: ea)
7bf947de2da2 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    92
			timeStamp: (aPseudoClass stampAt: ea)
7bf947de2da2 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    93
			source: (aPseudoClass sourceCodeAt: ea)]
7bf947de2da2 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    94
!
7bf947de2da2 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    95
7bf947de2da2 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    96
systemOrganizationFromRecords: changeRecords
7bf947de2da2 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    97
	| categories |
209
780f37190c97 added: #version_CVS
Claus Gittinger <cg@exept.de>
parents: 41
diff changeset
    98
	categories := changeRecords
41
7bf947de2da2 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    99
					select: [:ea | 'SystemOrganization*' match: ea string]
7bf947de2da2 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   100
					thenCollect: [:ea | (self categoryFromDoIt: ea string)].
7bf947de2da2 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   101
	^ categories isEmpty ifFalse: [MCOrganizationDefinition categories: categories asArray]
7bf947de2da2 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   102
!
7bf947de2da2 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   103
7bf947de2da2 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   104
typeOfSubclass: aSymbol
7bf947de2da2 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   105
	#(
7bf947de2da2 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   106
		(subclass: normal)
7bf947de2da2 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   107
		(variableSubclass: variable)
7bf947de2da2 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   108
		(variableByteSubclass: bytes)
7bf947de2da2 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   109
		(variableWordSubclass: words)
7bf947de2da2 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   110
		(weakSubclass: weak)
7bf947de2da2 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   111
		) do: [:ea | ea first = aSymbol ifTrue: [^ ea second]].
7bf947de2da2 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   112
	self error: 'Unrecognized class definition'
7bf947de2da2 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   113
! !
7bf947de2da2 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   114
7bf947de2da2 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   115
!MCStReader methodsFor:'evaluating'!
7bf947de2da2 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   116
7bf947de2da2 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   117
loadDefinitions
7bf947de2da2 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   118
	| filePackage |
209
780f37190c97 added: #version_CVS
Claus Gittinger <cg@exept.de>
parents: 41
diff changeset
   119
	filePackage :=
41
7bf947de2da2 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   120
		FilePackage new
7bf947de2da2 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   121
			fullName: 'ReadStream';
7bf947de2da2 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   122
			fileInFrom: self readStream.
209
780f37190c97 added: #version_CVS
Claus Gittinger <cg@exept.de>
parents: 41
diff changeset
   123
	definitions := OrderedCollection new.
41
7bf947de2da2 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   124
	filePackage classes do:
7bf947de2da2 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   125
		[:pseudoClass |
7bf947de2da2 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   126
		pseudoClass hasDefinition
7bf947de2da2 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   127
			ifTrue: [definitions add:
7bf947de2da2 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   128
					(self classDefinitionFrom: pseudoClass)].
7bf947de2da2 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   129
		definitions addAll: (self methodDefinitionsFor: pseudoClass).
7bf947de2da2 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   130
		definitions addAll: (self methodDefinitionsFor: pseudoClass metaClass)].
7bf947de2da2 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   131
	filePackage doIts do:
7bf947de2da2 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   132
		[:ea |
7bf947de2da2 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   133
		self addDefinitionsFromDoit: ea string].
7bf947de2da2 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   134
	
7bf947de2da2 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   135
!
7bf947de2da2 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   136
7bf947de2da2 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   137
readStream
7bf947de2da2 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   138
	^ ('!!!!
7bf947de2da2 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   139
7bf947de2da2 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   140
', stream contents) readStream
7bf947de2da2 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   141
! !
7bf947de2da2 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   142
7bf947de2da2 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   143
!MCStReader class methodsFor:'documentation'!
7bf947de2da2 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   144
7bf947de2da2 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   145
version
209
780f37190c97 added: #version_CVS
Claus Gittinger <cg@exept.de>
parents: 41
diff changeset
   146
    ^ '$Header: /cvs/stx/stx/goodies/monticello/MCStReader.st,v 1.2 2011-08-20 11:43:28 cg Exp $'
780f37190c97 added: #version_CVS
Claus Gittinger <cg@exept.de>
parents: 41
diff changeset
   147
!
780f37190c97 added: #version_CVS
Claus Gittinger <cg@exept.de>
parents: 41
diff changeset
   148
780f37190c97 added: #version_CVS
Claus Gittinger <cg@exept.de>
parents: 41
diff changeset
   149
version_CVS
780f37190c97 added: #version_CVS
Claus Gittinger <cg@exept.de>
parents: 41
diff changeset
   150
    ^ '$Header: /cvs/stx/stx/goodies/monticello/MCStReader.st,v 1.2 2011-08-20 11:43:28 cg Exp $'
780f37190c97 added: #version_CVS
Claus Gittinger <cg@exept.de>
parents: 41
diff changeset
   151
!
780f37190c97 added: #version_CVS
Claus Gittinger <cg@exept.de>
parents: 41
diff changeset
   152
780f37190c97 added: #version_CVS
Claus Gittinger <cg@exept.de>
parents: 41
diff changeset
   153
version_SVN
780f37190c97 added: #version_CVS
Claus Gittinger <cg@exept.de>
parents: 41
diff changeset
   154
    ^ '§Id: MCStReader.st 17 2010-10-13 12:07:52Z vranyj1 §'
41
7bf947de2da2 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   155
! !