1 "{ Encoding: utf8 }" |
|
2 |
|
3 "{ Package: 'stx:goodies/monticello' }" |
1 "{ Package: 'stx:goodies/monticello' }" |
4 |
2 |
5 "{ NameSpace: Smalltalk }" |
3 "{ NameSpace: Smalltalk }" |
6 |
4 |
7 MCStXSnapshotTransformation subclass:#MCStXSnapshotPreWriteTransformation |
5 MCStXSnapshotTransformation subclass:#MCStXSnapshotPreWriteTransformation |
8 instanceVariableNames:'extensionMethodCategoryMap projectDefinition' |
6 instanceVariableNames:'extensionMethodCategoryMap projectDefinition includeExtrasForSTX' |
9 classVariableNames:'' |
7 classVariableNames:'' |
10 poolDictionaries:'' |
8 poolDictionaries:'' |
11 category:'SCM-Monticello-St/X Storing' |
9 category:'SCM-Monticello-St/X Storing' |
12 ! |
10 ! |
13 |
11 |
25 [class variables:] |
23 [class variables:] |
26 |
24 |
27 [see also:] |
25 [see also:] |
28 |
26 |
29 " |
27 " |
|
28 ! ! |
|
29 |
|
30 !MCStXSnapshotPreWriteTransformation class methodsFor:'transforming'! |
|
31 |
|
32 transform: anMCSnapshot |
|
33 "Returns a transformed **copy** of the original snapshot" |
|
34 |
|
35 ^self new transform: anMCSnapshot includeExtrasForSTX: true |
|
36 |
|
37 "Created: / 23-04-2015 / 23:17:01 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
|
38 ! |
|
39 |
|
40 transform: anMCSnapshot includeExtrasForSTX: aBoolean |
|
41 ^self new transform: anMCSnapshot includeExtrasForSTX: aBoolean |
|
42 |
|
43 "Created: / 23-04-2015 / 23:16:38 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
30 ! ! |
44 ! ! |
31 |
45 |
32 !MCStXSnapshotPreWriteTransformation methodsFor:'accessing'! |
46 !MCStXSnapshotPreWriteTransformation methodsFor:'accessing'! |
33 |
47 |
34 monticelloName |
48 monticelloName |
104 !MCStXSnapshotPreWriteTransformation methodsFor:'transforming'! |
118 !MCStXSnapshotPreWriteTransformation methodsFor:'transforming'! |
105 |
119 |
106 transform: anMCSnapshot |
120 transform: anMCSnapshot |
107 "Returns a transformed **copy** of the original snapshot" |
121 "Returns a transformed **copy** of the original snapshot" |
108 |
122 |
|
123 includeExtrasForSTX := anMCSnapshot includeExtrasForSTX. |
109 extensionMethodCategoryMap := OrderedCollection new. |
124 extensionMethodCategoryMap := OrderedCollection new. |
110 original := anMCSnapshot. |
125 original := anMCSnapshot. |
111 projectDefinition := self projectDefinition. |
126 projectDefinition := self projectDefinition. |
112 projectDefinition isNil ifTrue:[ |
127 projectDefinition isNil ifTrue:[ |
113 "/ Not a Smalltalk/X package - no transformation |
128 "/ Not a Smalltalk/X package - no transformation |
136 source: source) |
151 source: source) |
137 ]. |
152 ]. |
138 ^transformed. |
153 ^transformed. |
139 |
154 |
140 "Created: / 31-05-2013 / 00:05:45 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
155 "Created: / 31-05-2013 / 00:05:45 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
141 "Modified (format): / 12-06-2013 / 09:23:47 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
156 "Modified: / 24-04-2015 / 12:39:01 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
|
157 ! |
|
158 |
|
159 transform: anMCSnapshot includeExtrasForSTX: aBoolean |
|
160 includeExtrasForSTX := aBoolean. |
|
161 ^ self transform: anMCSnapshot |
|
162 |
|
163 "Created: / 23-04-2015 / 23:17:44 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
142 ! ! |
164 ! ! |
143 |
165 |
144 !MCStXSnapshotPreWriteTransformation methodsFor:'visiting'! |
166 !MCStXSnapshotPreWriteTransformation methodsFor:'visiting'! |
145 |
167 |
146 visitClassDefinition: definition |
168 visitClassDefinition: definition |
151 " |
173 " |
152 | class | |
174 | class | |
153 |
175 |
154 class := definition actualClass. |
176 class := definition actualClass. |
155 class isProjectDefinition ifTrue:[ |
177 class isProjectDefinition ifTrue:[ |
156 definition |
178 transformed definitions remove: definition. |
157 "/ className:(definition className capitalized); |
179 includeExtrasForSTX ifTrue:[ |
158 superclassName: #Object; |
180 definition |
159 category: class monticelloName. |
181 "/ className:(definition className capitalized); |
160 |
182 superclassName: #Object; |
161 transformed definitions addFirst: |
183 category: class monticelloName. |
162 (MCMethodDefinition |
184 |
163 className: definition className |
185 transformed definitions addFirst: |
164 classIsMeta: true |
186 (MCMethodDefinition |
165 selector: 'monticelloProjectDefinitionTypeName' |
187 className: definition className |
166 category: 'accessing - monticello' |
188 classIsMeta: true |
167 timeStamp: 'Generated by ', self class name , ' at ' , Timestamp now printString |
189 selector: 'monticelloProjectDefinitionTypeName' |
168 source: |
190 category: 'accessing - monticello' |
169 (self monticelloSmalltalkXProjectType_Code bindWith: (class isApplicationDefinition ifTrue:[#application] ifFalse:[#library]) storeString)) |
191 timeStamp: 'Generated by ', self class name , ' at ' , Timestamp now printString |
|
192 source: |
|
193 (self monticelloSmalltalkXProjectType_Code bindWith: (class isApplicationDefinition ifTrue:[#application] ifFalse:[#library]) storeString)) |
|
194 ] |
170 ] |
195 ] |
171 |
196 |
172 "Created: / 29-05-2013 / 12:19:44 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
197 "Created: / 29-05-2013 / 12:19:44 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
173 "Modified: / 20-09-2013 / 00:14:04 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
198 "Modified: / 23-04-2015 / 23:26:16 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
174 ! |
199 ! |
175 |
200 |
176 visitMethodDefinition: definition |
201 visitMethodDefinition: definition |
177 | source| |
202 | class source | |
|
203 |
|
204 "/ If St/X extras should not be included, then remove all methods |
|
205 "/ that belong to project definition class. |
|
206 includeExtrasForSTX ifFalse:[ |
|
207 class := definition actualClass. |
|
208 class == projectDefinition ifTrue:[ |
|
209 transformed definitions remove: definition. |
|
210 ^ self. |
|
211 ]. |
|
212 ]. |
178 |
213 |
179 source := definition source asStringWithNativeLineEndings asStringCollection withTabs asStringWithSqueakLineEndings. |
214 source := definition source asStringWithNativeLineEndings asStringCollection withTabs asStringWithSqueakLineEndings. |
180 source := source asSingleByteStringIfPossible. |
215 source := source asSingleByteStringIfPossible. |
181 definition source: source. |
216 definition source: source. |
182 |
217 |
193 definition category: '*' , self monticelloName. |
228 definition category: '*' , self monticelloName. |
194 ] |
229 ] |
195 ]. |
230 ]. |
196 |
231 |
197 "Created: / 30-05-2013 / 22:48:36 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
232 "Created: / 30-05-2013 / 22:48:36 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
198 "Modified: / 06-11-2014 / 03:11:07 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
233 "Modified: / 23-04-2015 / 23:31:08 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
199 ! |
234 ! |
200 |
235 |
201 visitOrganizationDefinition: defintion |
236 visitOrganizationDefinition: defintion |
202 "Add a category in which project definition class is..." |
237 "Add a category in which project definition class is..." |
203 |
238 |